home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / hypgeo.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  49.9 KB  |  2,389 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2.  
  3.  
  4. ;    ** (c) Copyright 1976, 1983 Massachusetts Institute of Technology **
  5. (in-package "MAXIMA")
  6.  
  7. ;These are the main routines for finding the Laplace Transform
  8. ; of special functions   --- written by Yannis Avgoustis
  9. ;                        --- modified by Edward Lafferty
  10. ;                       Latest mod by jpg 8/21/81
  11. ;
  12. ;   This program uses the programs on ELL;HYP FASL.
  13.  
  14. (macsyma-module hypgeo)
  15.  
  16. (DECLARE-top (SPECIAL VAR PAR ZEROSIGNTEST PRODUCTCASE CHECKCOEFSIGNLIST
  17.           $EXPONENTIALIZE $RADEXPAND))
  18.  
  19. (load-macsyma-macros rzmac)
  20.  
  21. (DEFUN BESS
  22.        (V Z FLG)
  23.        (LIST '(MQAPPLY)
  24.          (LIST (COND ((EQ FLG 'J)'($%J ARRAY))
  25.              (T '($%I ARRAY)))
  26.            V)
  27.          Z))
  28.  
  29. (DEFUN CDRAS(A L)(CDR (ZL-ASSOC A L)))
  30.  
  31. (DEFUN GM(EXPR)(SIMPLIFYA (LIST '(%GAMMA) EXPR) NIL))
  32.  
  33. (DEFUN SIN%(ARG)(LIST '(%SIN) ARG))
  34.  
  35. (DEFUN NUMP
  36.        (X)
  37.        (COND ((ATOM X)(NUMBERP X))
  38.          ((NOT (ATOM X))(EQ (CAAR (SIMPLIFYA X NIL)) 'RAT))))
  39.  
  40. (DEFUN COS%(ARG)(LIST '(%COS) ARG))
  41.  
  42. (DEFUN NEGINP (A) (COND ((MAXIMA-INTEGERP A)(OR (ZERP A)(MINUSP A)))))
  43.  
  44. (DEFUN NOTNUMP(X)(NOT (NUMP X)))
  45.  
  46. (DEFUN NEGNUMP
  47.        (X)
  48.        (COND ((NOT (MAXIMA-INTEGERP X))
  49.           (MINUSP (CADR (SIMPLIFYA X NIL))))
  50.          (T (MINUSP X))))
  51.  
  52.  
  53.  
  54. (DEFUN EXPOR1P(EXP)(OR (EQUAL EXP 1)(EQ EXP '$%E)))
  55.  
  56. (DEFUN PARP(A)(EQ A PAR))
  57.  
  58.  
  59.  
  60. (DEFUN HASVAR(EXP)(COND ((FREEVAR EXP) NIL)(T T)))
  61.  
  62.  
  63.  
  64. (DEFUN ARBPOW1
  65.        (EXP)
  66.        (M2 EXP
  67.        '((MPLUS)
  68.          ((COEFFPT)
  69.           (C NONZERP)
  70.           ((MEXPT)(U HASVAR)(V FREEVAR)))
  71.          ((COEFFPP)(A ZERP)))
  72.        NIL))
  73.  
  74. (DEFUN U*ASINX
  75.        (EXP)
  76.        (M2 EXP
  77.        '((MPLUS)
  78.          ((COEFFPT) (U NONZERP)((%ASIN)(X HASVAR)))
  79.          ((COEFFPP)(A ZERP)))
  80.        NIL))
  81.  
  82. (DEFUN U*ATANX
  83.        (EXP)
  84.        (M2 EXP
  85.        '((MPLUS)
  86.          ((COEFFPT)(U NONZERP)((%ATAN)(X HASVAR)))
  87.          ((COEFFPP)(A ZERP)))
  88.        NIL))
  89.  
  90.  
  91.  
  92. (DEFUN GMINC(A B)(LIST '($GAMMAINCOMPLETE) A B))
  93.  
  94. (DEFUN LITTLESLOMMEL
  95.        (M N Z)
  96.        (LIST '(MQAPPLY)(LIST '($%S ARRAY) M N) Z))
  97.  
  98. (DEFUN MWHIT(A I1 I2)(LIST '(MQAPPLY)(LIST '($%M ARRAY) I1 I2) A))
  99.  
  100. (DEFUN WWHIT(A I1 I2)(LIST '(MQAPPLY)(LIST '($%W ARRAY) I1 I2) A))
  101.  
  102. (DEFUN PJAC(X N A B)(LIST '(MQAPPLY)(LIST '($%P ARRAY) N A B) X))
  103.  
  104. (DEFUN PARCYL(X N)(LIST '(MQAPPLY)(LIST '($%D ARRAY) N) X))
  105.  
  106.  
  107. ;...HOPEFULLY AMONG WHATEVER GARBAGE IT RECOGNIZES J[V](W).
  108.  
  109. (DEFUN ONEJ
  110.        (EXP)
  111.        (M2 EXP
  112.        '((MPLUS)
  113.          ((COEFFPT)
  114.           (U NONZERP)
  115.           ((MQAPPLY)(($%J ARRAY) (V TRUE)) (W TRUE)))
  116.          ((COEFFPP) (A ZERP)))
  117.        NIL))
  118.  
  119. ;...AMONG GARBAGE RECOGNIZES J[V1](W1)*J[V2](W2)
  120.  
  121.  
  122. (DEFUN TWOJ
  123.        (EXP)
  124.        (M2 EXP
  125.        '((MPLUS)
  126.          ((COEFFPT)
  127.           (U NONZERP)
  128.           ((MQAPPLY)(($%J ARRAY)(V1 TRUE))(W1 TRUE))
  129.           ((MQAPPLY)(($%J ARRAY)(V2 TRUE))(W2 TRUE)))
  130.          ((COEFFPP)(A ZERP)))
  131.        NIL))
  132.  
  133. (DEFUN TWOY
  134.        (EXP)
  135.        (M2 EXP
  136.        '((MPLUS)
  137.          ((COEFFPT)
  138.           (U NONZERP)
  139.           ((MQAPPLY)(($%Y ARRAY)(V1 TRUE))(W1 TRUE))
  140.           ((MQAPPLY)(($%Y ARRAY)(V2 TRUE))(W2 TRUE)))
  141.          ((COEFFPP)(A ZERP)))
  142.        NIL))
  143.  
  144. (DEFUN TWOK
  145.        (EXP)
  146.        (M2 EXP
  147.        '((MPLUS)
  148.          ((COEFFPT)
  149.           (U NONZERP)
  150.           ((MQAPPLY)(($%K ARRAY)(V1 TRUE))(W1 TRUE))
  151.           ((MQAPPLY)(($%K ARRAY)(V2 TRUE))(W2 TRUE)))
  152.          ((COEFFPP)(A ZERP)))
  153.        NIL))
  154.  
  155. (DEFUN ONEKONEY
  156.        (EXP)
  157.        (M2 EXP
  158.        '((MPLUS)
  159.          ((COEFFPT)
  160.           (U NONZERP)
  161.           ((MQAPPLY)(($%K ARRAY)(V1 TRUE))(W1 TRUE))
  162.           ((MQAPPLY)(($%Y ARRAY)(V2 TRUE))(W2 TRUE)))
  163.          ((COEFFPP)(A ZERP)))
  164.        NIL))
  165.  
  166. ;...AMONG GARBAGE RECOGNIZES J[V](W)^2.
  167.  
  168.  
  169. (DEFUN ONEJ^2
  170.        (EXP)
  171.        (M2 EXP
  172.        '((MPLUS)
  173.          ((COEFFPT)
  174.           (U NONZERP)
  175.           ((MEXPT)
  176.            ((MQAPPLY)(($%J ARRAY)(V TRUE))(W TRUE))
  177.            2.))
  178.          ((COEFFPP)(A ZERP)))
  179.        NIL))
  180.  
  181. (DEFUN ONEY^2
  182.        (EXP)
  183.        (M2 EXP
  184.        '((MPLUS)
  185.          ((COEFFPT)
  186.           (U NONZERP)
  187.           ((MEXPT)
  188.            ((MQAPPLY)(($%Y ARRAY)(V TRUE))(W TRUE))
  189.            2.))
  190.          ((COEFFPP)(A ZERP)))
  191.        NIL))
  192.  
  193. (DEFUN ONEK^2
  194.        (EXP)
  195.        (M2 EXP
  196.        '((MPLUS)
  197.          ((COEFFPT)
  198.           (U NONZERP)
  199.           ((MEXPT)
  200.            ((MQAPPLY)(($%K ARRAY)(V TRUE))(W TRUE))
  201.            2.))
  202.          ((COEFFPP)(A ZERP)))
  203.        NIL))
  204.  
  205. (DEFUN ONEI
  206.        (EXP)
  207.        (M2 EXP
  208.        '((MPLUS)
  209.          ((COEFFPT)
  210.           (U NONZERP)
  211.           ((MQAPPLY)(($%I ARRAY) (V TRUE)) (W TRUE)))
  212.          ((COEFFPP) (A ZERP)))
  213.        NIL))
  214.  
  215. (DEFUN TWOI
  216.        (EXP)
  217.        (M2 EXP
  218.        '((MPLUS)
  219.          ((COEFFPT)
  220.           (U NONZERP)
  221.           ((MQAPPLY)(($%I ARRAY)(V1 TRUE))(W1 TRUE))
  222.           ((MQAPPLY)(($%I ARRAY)(V2 TRUE))(W2 TRUE)))
  223.          ((COEFFPP)(A ZERP)))
  224.        NIL))
  225.  
  226. (DEFUN TWOH
  227.        (EXP)
  228.        (M2 EXP
  229.        '((MPLUS)
  230.          ((COEFFPT)
  231.           (U NONZERP)
  232.           ((MQAPPLY)
  233.            (($%H ARRAY)(V1 TRUE)(V11 TRUE))
  234.            (W1 TRUE))
  235.           ((MQAPPLY)
  236.            (($%H ARRAY)(V2 TRUE)(V21 TRUE))
  237.            (W2 TRUE)))
  238.          ((COEFFPP)(A ZERP)))
  239.        NIL))
  240.  
  241. (DEFUN ONEYONEJ
  242.        (EXP)
  243.        (M2 EXP
  244.        '((MPLUS)
  245.          ((COEFFPT)
  246.           (U NONZERP)
  247.           ((MQAPPLY)(($%Y ARRAY)(V1 TRUE))(W1 TRUE))
  248.           ((MQAPPLY)(($%J ARRAY)(V2 TRUE))(W2 TRUE)))
  249.          ((COEFFPP)(A ZERP)))
  250.        NIL))
  251.  
  252. (DEFUN ONEKONEJ
  253.        (EXP)
  254.        (M2 EXP
  255.        '((MPLUS)
  256.          ((COEFFPT)
  257.           (U NONZERP)
  258.           ((MQAPPLY)(($%K ARRAY)(V1 TRUE))(W1 TRUE))
  259.           ((MQAPPLY)(($%J ARRAY)(V2 TRUE))(W2 TRUE)))
  260.          ((COEFFPP)(A ZERP)))
  261.        NIL))
  262.  
  263. (DEFUN ONEYONEH
  264.        (EXP)
  265.        (M2 EXP
  266.        '((MPLUS)
  267.          ((COEFFPT)
  268.           (U NONZERP)
  269.           ((MQAPPLY)(($%Y ARRAY)(V1 TRUE))(W1 TRUE))
  270.           ((MQAPPLY)
  271.            (($%H ARRAY)(V2 TRUE)(V21 TRUE))
  272.            (W2 TRUE)))
  273.          ((COEFFPP)(A ZERP)))
  274.        NIL))
  275.  
  276. (DEFUN ONEKONEH
  277.        (EXP)
  278.        (M2 EXP
  279.        '((MPLUS)
  280.          ((COEFFPT)
  281.           (U NONZERP)
  282.           ((MQAPPLY)(($%K ARRAY)(V1 TRUE))(W1 TRUE))
  283.           ((MQAPPLY)
  284.            (($%H ARRAY)(V2 TRUE)(V21 TRUE))
  285.            (W2 TRUE)))
  286.          ((COEFFPP)(A ZERP)))
  287.        NIL))
  288.  
  289. (DEFUN ONEIONEJ
  290.        (EXP)
  291.        (M2 EXP
  292.        '((MPLUS)
  293.          ((COEFFPT)
  294.           (U NONZERP)
  295.           ((MQAPPLY)(($%I ARRAY)(V1 TRUE))(W1 TRUE))
  296.           ((MQAPPLY)(($%J ARRAY)(V2 TRUE))(W2 TRUE)))
  297.          ((COEFFPP)(A ZERP)))
  298.        NIL))
  299.  
  300. (DEFUN ONEIONEH
  301.        (EXP)
  302.        (M2 EXP
  303.        '((MPLUS)
  304.          ((COEFFPT)
  305.           (U NONZERP)
  306.           ((MQAPPLY)(($%I ARRAY)(V1 TRUE))(W1 TRUE))
  307.           ((MQAPPLY)
  308.            (($%H ARRAY)(V2 TRUE)(V21 TRUE))
  309.            (W2 TRUE)))
  310.          ((COEFFPP)(A ZERP)))
  311.        NIL))
  312.  
  313. (DEFUN ONEHONEJ
  314.        (EXP)
  315.        (M2 EXP
  316.        '((MPLUS)
  317.          ((COEFFPT)
  318.           (U NONZERP)
  319.           ((MQAPPLY)
  320.            (($%H ARRAY)(V1 TRUE)(V11 TRUE))
  321.            (W1 TRUE))
  322.           ((MQAPPLY)(($%J ARRAY)(V2 TRUE))(W2 TRUE)))
  323.          ((COEFFPP)(A ZERP)))
  324.        NIL))
  325.  
  326. (DEFUN ONEIONEY
  327.        (EXP)
  328.        (M2 EXP
  329.        '((MPLUS)
  330.          ((COEFFPT)
  331.           (U NONZERP)
  332.           ((MQAPPLY)(($%I ARRAY)(V1 TRUE))(W1 TRUE))
  333.           ((MQAPPLY)(($%Y ARRAY)(V2 TRUE))(W2 TRUE)))
  334.          ((COEFFPP)(A ZERP)))
  335.        NIL))
  336.  
  337. (DEFUN ONEIONEK
  338.        (EXP)
  339.        (M2 EXP
  340.        '((MPLUS)
  341.          ((COEFFPT)
  342.           (U NONZERP)
  343.           ((MQAPPLY)(($%I ARRAY)(V1 TRUE))(W1 TRUE))
  344.           ((MQAPPLY)(($%K ARRAY)(V2 TRUE))(W2 TRUE)))
  345.          ((COEFFPP)(A ZERP)))
  346.        NIL))
  347.  
  348. (DEFUN ONEI^2
  349.        (EXP)
  350.        (M2 EXP
  351.        '((MPLUS)
  352.          ((COEFFPT)
  353.           (U NONZERP)
  354.           ((MEXPT)
  355.            ((MQAPPLY)(($%I ARRAY)(V TRUE))(W TRUE))
  356.            2.))
  357.          ((COEFFPP)(A ZERP)))
  358.        NIL))
  359.  
  360. (DEFUN ONEH^2
  361.        (EXP)
  362.        (M2 EXP
  363.        '((MPLUS)
  364.          ((COEFFPT)
  365.           (U NONZERP)
  366.           ((MEXPT)
  367.            ((MQAPPLY)
  368.         (($%H ARRAY)(V1 TRUE)(V2 TRUE))
  369.         (W TRUE))
  370.            2.))
  371.          ((COEFFPP)(A ZERP)))
  372.        NIL))
  373.  
  374. (DEFUN ONERF
  375.        (EXP)
  376.        (M2 EXP
  377.        '((MPLUS)
  378.          ((COEFFPT)(U NONZERP)((%ERF)(W TRUE)))
  379.          ((COEFFPP)(A ZERP)))
  380.        NIL))
  381.  
  382. (DEFUN ONELOG
  383.        (EXP)
  384.        (M2 EXP
  385.        '((MPLUS)
  386.          ((COEFFPT)(U NONZERP)((%LOG)(W HASVAR)))
  387.          ((COEFFPP)(A ZERP)))
  388.        NIL))
  389.  
  390. (DEFUN ONERFC
  391.        (EXP)
  392.        (M2 EXP
  393.        '((MPLUS)
  394.          ((COEFFPT)(U NONZERP)(($ERFC)(W TRUE)))
  395.          ((COEFFPP)(A ZERP)))
  396.        NIL))
  397.  
  398. (DEFUN ONEEI
  399.        (EXP)
  400.        (M2 EXP
  401.        '((MPLUS)
  402.          ((COEFFPT)(U NONZERP)(($%EI)(W TRUE)))
  403.          ((COEFFPP)(A ZERP)))
  404.        NIL))
  405.  
  406. (DEFUN ONEKELLIPTIC
  407.        (EXP)
  408.        (M2 EXP
  409.        '((MPLUS)
  410.          ((COEFFPT)(U NONZERP)(($KELLIPTIC)(W TRUE)))
  411.          ((COEFFPP)(A ZERP)))
  412.        NIL))
  413.  
  414. (DEFUN ONEE
  415.        (EXP)
  416.        (M2 EXP
  417.        '((MPLUS)
  418.          ((COEFFPT)(U NONZERP)(($%E)(W TRUE)))
  419.          ((COEFFPP)(A ZERP)))
  420.        NIL))
  421.  
  422. (DEFUN ONEGAMMAINCOMPLETE
  423.        (EXP)
  424.        (M2 EXP
  425.        '((MPLUS)
  426.          ((COEFFPT)
  427.           (U NONZERP)
  428.           (($GAMMAINCOMPLETE)(W1 FREEVARPAR)(W2 TRUE)))
  429.          ((COEFFPP)(A ZERP)))
  430.        NIL))
  431.  
  432. (DEFUN ONEGAMMAGREEK
  433.        (EXP)
  434.        (M2 EXP
  435.        '((MPLUS)
  436.          ((COEFFPT)
  437.           (U NONZERP)
  438.           (($GAMMAGREEK)(W1 FREEVARPAR)(W2 TRUE)))
  439.          ((COEFFPP)(A ZERP)))
  440.        NIL))
  441.  
  442. (DEFUN ONEHSTRUVE
  443.        (EXP)
  444.        (M2 EXP
  445.        '((MPLUS)
  446.          ((COEFFPT)
  447.           (U NONZERP)
  448.           ((MQAPPLY)(($HSTRUVE ARRAY)(V TRUE))(W TRUE)))
  449.          ((COEFFPP)(A ZERP)))
  450.        NIL))
  451.  
  452. (DEFUN ONELSTRUVE
  453.        (EXP)
  454.        (M2 EXP
  455.        '((MPLUS)
  456.          ((COEFFPT)
  457.           (U NONZERP)
  458.           ((MQAPPLY)(($LSTRUVE ARRAY)(V TRUE))(W TRUE)))
  459.          ((COEFFPP)(A ZERP)))
  460.        NIL))
  461.  
  462. (DEFUN ONES
  463.        (EXP)
  464.        (M2 EXP
  465.        '((MPLUS)
  466.          ((COEFFPT)
  467.           (U NONZERP)
  468.           ((MQAPPLY)(($%S ARRAY)(V1 TRUE)(V2 TRUE))(W TRUE)))
  469.          ((COEFFPP)(A ZERP)))
  470.        NIL))
  471.  
  472. (DEFUN ONESLOMMEL
  473.        (EXP)
  474.        (M2 EXP
  475.        '((MPLUS)
  476.          ((COEFFPT)
  477.           (U NONZERP)
  478.           ((MQAPPLY)
  479.            (($SLOMMEL ARRAY)(V1 TRUE)(V2 TRUE))
  480.            (W TRUE)))
  481.          ((COEFFPP)(A ZERP)))
  482.        NIL))
  483.  
  484. (DEFUN ONEY
  485.        (EXP)
  486.        (M2 EXP
  487.        '((MPLUS)
  488.          ((COEFFPT)
  489.           (U NONZERP)
  490.           ((MQAPPLY)(($%Y ARRAY) (V TRUE)) (W TRUE)))
  491.          ((COEFFPP) (A ZERP)))
  492.        NIL))
  493.  
  494. (DEFUN ONEK
  495.        (EXP)
  496.        (M2 EXP
  497.        '((MPLUS)
  498.          ((COEFFPT)
  499.           (U NONZERP)
  500.           ((MQAPPLY)(($%K ARRAY) (V TRUE)) (W TRUE)))
  501.          ((COEFFPP) (A ZERP)))
  502.        NIL))
  503.  
  504. (DEFUN ONED
  505.        (EXP)
  506.        (M2 EXP
  507.        '((MPLUS)
  508.          ((COEFFPT)
  509.           (U NONZERP)
  510.           ((MQAPPLY)(($%D ARRAY) (V TRUE)) (W TRUE)))
  511.          ((COEFFPP) (A ZERP)))
  512.        NIL))
  513.  
  514. (DEFUN ONEKBATEMAN
  515.        (EXP)
  516.        (M2 EXP
  517.        '((MPLUS)
  518.          ((COEFFPT)
  519.           (U NONZERP)
  520.           ((MQAPPLY)(($KBATEMAN ARRAY) (V TRUE)) (W TRUE)))
  521.          ((COEFFPP) (A ZERP)))
  522.        NIL))
  523.  
  524. (DEFUN ONEH
  525.        (EXP)
  526.        (M2 EXP
  527.        '((MPLUS)
  528.          ((COEFFPT)
  529.           (U NONZERP)
  530.           ((MQAPPLY)
  531.            (($%H ARRAY) (V1 TRUE)(V2 TRUE))
  532.            (W TRUE)))
  533.          ((COEFFPP) (A ZERP)))
  534.        NIL))
  535.  
  536. (DEFUN ONEM
  537.        (EXP)
  538.        (M2 EXP
  539.        '((MPLUS)
  540.          ((COEFFPT)
  541.           (U NONZERP)
  542.           ((MQAPPLY)
  543.            (($%M ARRAY) (V1 TRUE)(V2 TRUE))
  544.            (W TRUE)))
  545.          ((COEFFPP) (A ZERP)))
  546.        NIL))
  547.  
  548. (DEFUN ONEL
  549.        (EXP)
  550.        (M2 EXP
  551.        '((MPLUS)
  552.          ((COEFFPT)
  553.           (U NONZERP)
  554.           ((MQAPPLY)
  555.            (($%L ARRAY) (V1 TRUE)(V2 TRUE))
  556.            (W TRUE)))
  557.          ((COEFFPP) (A ZERP)))
  558.        NIL))
  559.  
  560. (DEFUN ONEC
  561.        (EXP)
  562.        (M2 EXP
  563.        '((MPLUS)
  564.          ((COEFFPT)
  565.           (U NONZERP)
  566.           ((MQAPPLY)
  567.            (($%C ARRAY) (V1 TRUE)(V2 TRUE))
  568.            (W TRUE)))
  569.          ((COEFFPP) (A ZERP)))
  570.        NIL))
  571.  
  572. (DEFUN ONET
  573.        (EXP)
  574.        (M2 EXP
  575.        '((MPLUS)
  576.          ((COEFFPT)
  577.           (U NONZERP)
  578.           ((MQAPPLY)(($%T ARRAY) (V1 TRUE)) (W TRUE)))
  579.          ((COEFFPP) (A ZERP)))
  580.        NIL))
  581.  
  582. (DEFUN ONEU
  583.        (EXP)
  584.        (M2 EXP
  585.        '((MPLUS)
  586.          ((COEFFPT)
  587.           (U NONZERP)
  588.           ((MQAPPLY)(($%U ARRAY) (V1 TRUE)) (W TRUE)))
  589.          ((COEFFPP) (A ZERP)))
  590.        NIL))
  591.  
  592. (DEFUN ONEPJAC
  593.        (EXP)
  594.        (M2 EXP
  595.        '((MPLUS)
  596.          ((COEFFPT)
  597.           (U NONZERP)
  598.           ((MQAPPLY)
  599.            (($%P ARRAY) (V1 TRUE)(V2 TRUE)(V3 TRUE))
  600.            (W TRUE)))
  601.          ((COEFFPP) (A ZERP)))
  602.        NIL))
  603.  
  604. (DEFUN ONEHE
  605.        (EXP)
  606.        (M2 EXP
  607.        '((MPLUS)
  608.          ((COEFFPT)
  609.           (U NONZERP)
  610.           ((MQAPPLY)(($%HE ARRAY) (V1 TRUE)) (W TRUE)))
  611.          ((COEFFPP) (A ZERP)))
  612.        NIL))
  613.  
  614. (DEFUN ONEQ
  615.        (EXP)
  616.        (M2 EXP
  617.        '((MPLUS)
  618.          ((COEFFPT)
  619.           (U NONZERP)
  620.           ((MQAPPLY)
  621.            (($%Q ARRAY) (V1 TRUE)(V2 TRUE))
  622.            (W TRUE)))
  623.          ((COEFFPP) (A ZERP)))
  624.        NIL))
  625.  
  626. (DEFUN ONEP0
  627.        (EXP)
  628.        (M2 EXP
  629.        '((MPLUS)
  630.          ((COEFFPT)
  631.           (U NONZERP)
  632.           ((MQAPPLY)(($%P ARRAY) (V1 TRUE)) (W TRUE)))
  633.          ((COEFFPP) (A ZERP)))
  634.        NIL))
  635.  
  636. (DEFUN HYP-ONEP
  637.        (EXP)
  638.        (M2 EXP
  639.        '((MPLUS)
  640.          ((COEFFPT)
  641.           (U NONZERP)
  642.           ((MQAPPLY)
  643.            (($%P ARRAY) (V1 TRUE)(V2 TRUE))
  644.            (W TRUE)))
  645.          ((COEFFPP) (A ZERP)))
  646.        NIL))
  647.  
  648. (DEFUN ONEW
  649.        (EXP)
  650.        (M2 EXP
  651.        '((MPLUS)
  652.          ((COEFFPT)
  653.           (U NONZERP)
  654.           ((MQAPPLY)
  655.            (($%W ARRAY) (V1 TRUE)(V2 TRUE))
  656.            (W TRUE)))
  657.          ((COEFFPP) (A ZERP)))
  658.        NIL))
  659.  
  660.  
  661.  
  662.  
  663.  
  664.  
  665.  
  666.  
  667. ;...RECOGNIZES L.T.E. "U*%E^(A*X+E*F(X)-P*X+C)+D".
  668.  
  669. (DEFUN LTEP
  670.        (EXP)
  671.        (M2 EXP
  672.        '((MPLUS)
  673.          ((COEFFPT)
  674.           (U NONZERP)
  675.           ((MEXPT)
  676.            $%E
  677.            ((MPLUS)
  678.         ((COEFFPT) (A FREEVARPAR) (X VARP))
  679.         ((COEFFPT) (E FREEVARPAR) (F HASVAR))
  680.         ((MTIMES) -1. (P PARP) (X VARP))
  681.         ((COEFFPP) (C FREEVARPAR)))))
  682.          ((COEFFPP) (D ZERP)))
  683.        NIL)) 
  684.  
  685. (DEFUN ZERP(A)(EQUAL A 0))
  686.  
  687. (DEFUN NONZERP(A)(NOT (ZERP A)))
  688.  
  689. (DEFMFUN $SPECINT (EXP VAR)
  690.        (PROG ($radexpand CHECKCOEFSIGNLIST)
  691.         (progn (FIND-FUNCTION 'SININT))
  692.         (setq $radexpand '$all)
  693.         (RETURN (GRASP-SOME-TRIGS EXP))))
  694.  
  695. (declare-top (special asinx atanx))
  696. (setq asinx nil atanx nil)
  697. (DEFUN GRASP-SOME-TRIGS
  698.        (EXP)
  699.        (PROG(U X L )
  700.         (COND ((SETQ L (U*ASINX EXP))
  701.            (SETQ U
  702.              (CDRAS 'U L)
  703.              X
  704.              (CDRAS 'X L)
  705.              ASINX
  706.              'T)
  707.            (RETURN (DEFINTEGRATE U))))
  708.         (COND ((SETQ L (U*ATANX EXP))
  709.            (SETQ U
  710.              (CDRAS 'U L)
  711.              X
  712.              (CDRAS 'X L)
  713.              ATANX
  714.              'T)
  715.            (RETURN (DEFINTEGRATE U))))
  716.         (RETURN (DEFINTEGRATE EXP))))
  717.  
  718.  
  719.  
  720. (DEFUN DEFINTEGRATE
  721.        (EXP)
  722.        (PROG ($EXPONENTIALIZE)
  723.          (SETQ $EXPONENTIALIZE t)
  724.          (RETURN (DISTRDEFEXECINIT ($EXPAND (SSIMPLIFYA EXP))))))
  725.  
  726.  
  727. (DEFUN DEFEXEC
  728.        (EXP VAR)
  729.        (PROG(L A)
  730.         (SETQ EXP (SIMPLIFYA EXP NIL))
  731.         (COND ((SETQ L (DEFLTEP EXP))
  732.            (SETQ A (CDRAS 'A L))
  733.            (RETURN (NEGTEST L A))))
  734.         (RETURN 'OTHER-DEFINT-TO-FOLLOW-DEFEXEC)))
  735.  
  736. (DEFUN NEGTEST
  737.        (L A)
  738.        (PROG(U E F C)
  739.         (COND ((EQ (CHECKSIGNTM ($REALPART A)) '$NEGATIVE)
  740.            (SETQ U
  741.              (CDRAS 'U L)
  742.              E
  743.              (CDRAS 'E L)
  744.              F
  745.              (CDRAS 'F L)
  746.              C
  747.              (CDRAS 'C L))
  748.            (COND ((ZERP E)(SETQ F 1)))
  749.            (RETURN (MAXIMA-SUBSTITUTE (MUL -1 A)
  750.                        'PSEY
  751.                        (LTSCALE U
  752.                         VAR
  753.                         'PSEY
  754.                         C
  755.                         0
  756.                         E
  757.                         F)))))
  758.         (RETURN 'OTHER-DEFINT-TO-FOLLOW-NEGTEST)))
  759.  
  760. (DEFUN LTSCALE
  761.        (EXP VAR PAR C PAR0 E F)
  762.        (MUL* (POWER '$%E C)
  763.         (SUBSTL (SUB PAR PAR0) PAR (LT-EXEC EXP E F))))
  764.  
  765. (DEFUN DEFLTEP
  766.        (EXP)
  767.        (M2 EXP
  768.        '((MPLUS)
  769.          ((COEFFPT)
  770.           (U NONZERP)
  771.           ((MEXPT)
  772.            $%E
  773.            ((MPLUS)
  774.         ((COEFFPT) (A FREEVAR) (X VARP))
  775.         ((COEFFPT) (E FREEVAR) (F HASVARNOVARP))
  776.         ((COEFFPP) (C FREEVAR)))))
  777.          ((COEFFPP) (D ZERP)))
  778.        NIL))
  779.  
  780. (DEFUN HASVARNOVARP (A) (AND (HASVAR A) (NOT (VARP A))))
  781. ;it dispatches according to the kind of transform it matches
  782.  
  783.  
  784. (DEFUN HYPGEO-EXEC (EXP VAR PAR)
  785.        (PROG (L U A C E F)
  786.         (SETQ EXP (SIMPLIFYA EXP NIL))
  787.         (COND ((SETQ L (LTEP EXP))
  788.            (SETQ U (CDRAS 'U L)
  789.              A (CDRAS 'A L)
  790.              C (CDRAS 'C L)
  791.              E (CDRAS 'E L)
  792.              F (CDRAS 'F L))
  793.            (RETURN (LTSCALE U VAR PAR C A E F))))
  794.         (RETURN 'OTHER-TRANS-TO-FOLLOW)))
  795.  
  796. (DEFUN SUBSTL
  797.        (P1 P2 P3)
  798.        (COND ((EQ P1 P2) P3)(T (MAXIMA-SUBSTITUTE P1 P2 P3)))) 
  799.  
  800. (DEFUN LT-EXEC
  801.        (U E F)
  802.        (PROG(L)
  803.         (COND ((OR ASINX ATANX)(RETURN (LT-ASINATAN U E F))))
  804.         (COND ((ZERP E)(RETURN (LT-SF-LOG U))))
  805.         (COND ((AND (NOT (ZERP E))(SETQ L (C*T^V U)))
  806.            (RETURN (LT-EXP L E F))))
  807.         (RETURN (LT-SF-LOG (MUL* U (POWER '$%E (MUL E F)))))))
  808.  
  809. (DEFUN C*T^V
  810.        (EXP)
  811.        (M2 EXP
  812.        '((MTIMES)
  813.          ((COEFFTT)(C FREEVAR))
  814.          ((MEXPT)(T VARP)(V FREEVAR)))
  815.        NIL))
  816.  
  817. (DEFUN LT-ASINATAN
  818.        (U E F)
  819.        (COND ((ZERP E)
  820.           (COND (ASINX (LT-LTP 'ASIN U var NIL))
  821.             (ATANX (LT-LTP 'ATAN U var NIL))
  822.             (T 'LT-ASINATAN-FAILED-1)))
  823.          (T 'LT-ASINATAN-FAILED-2)))
  824.  
  825. (DEFUN LT-EXP
  826.        (L E F)
  827.        (PROG(C V)
  828.         (SETQ C (CDRAS 'C L) V (CDRAS 'V L))
  829.         (COND ((T^2 F)
  830.            (SETQ E (INV (MUL -8 E)) V (ADD V 1))
  831.            (RETURN (F24P146TEST C V E))))
  832.         (COND ((SQROOTT F)
  833.            (SETQ E (MUL* E E (INV 4)) V (ADD V 1))
  834.            (RETURN (F35P147TEST C V E))))
  835.         (COND ((T^-1 F)
  836.            (SETQ E (MUL -4 E) V (ADD V 1))
  837.            (RETURN (F29P146TEST C V E))))
  838.         (RETURN 'OTHER-LT-EXPONENTIAL-TO-FOLLOW)))
  839.  
  840. (DEFUN T^2(EXP)(M2 EXP '((MEXPT)(T VARP) 2) NIL))
  841.  
  842. (DEFUN SQROOTT(EXP)(M2 EXP '((MEXPT)(T VARP)((RAT) 1 2)) NIL))
  843.  
  844. (DEFUN T^-1(EXP)(M2 EXP '((MEXPT)(T VARP) -1) NIL))
  845.  
  846. (DEFUN F24P146TEST
  847.        (C V A)
  848.        (COND ((NOT (OR (NEGINP A)(NEGINP V)))(F24P146 C V A))
  849.          (T 'FAIL-ON-F24P146TEST)))
  850.  
  851. (DEFUN F35P147TEST
  852.        (C V A)
  853.        (COND ((NOT (NEGINP V))(F35P147 C V A))
  854.          (T 'FAIL-ON-F35P147TEST)))
  855.  
  856. (DEFUN F29P146TEST
  857.        (C V A)
  858.        (COND ((NOT (NEGINP A))(F29P146 C V A))
  859.          (T 'FAIL-ON-F29P146TEST)))
  860.  
  861. (DEFUN F1P137TEST
  862.        (POW)
  863.        (COND ((NOT (NEGINP (ADD POW 1)))(F1P137 POW))
  864.          (T 'FAIL-IN-ARBPOW))) 
  865.  
  866. (DEFUN F1P137
  867.        (POW)
  868.        (MUL* (GM (ADD POW 1))(POWER PAR (SUB (MUL -1 POW) 1))))
  869.  
  870. (DEFUN F24P146
  871.        (C V A)
  872.        (MUL* C
  873.          (GM V)
  874.          (POWER 2 V)
  875.          (POWER A (DIV V 2))
  876.          (POWER '$%E (MUL* A PAR PAR))
  877.          (DTFORD (MUL* 2 PAR (POWER A (1//2)))(MUL -1 V))))
  878.  
  879. (DEFUN F35P147
  880.        (C V A)
  881.        (MUL* C
  882.          (GM (ADD V V))
  883.          (POWER 2 (SUB 1 V))
  884.          (POWER PAR (MUL -1 V))
  885.          (POWER '$%E (MUL* A (1//2)(INV PAR)))
  886.          (DTFORD (POWER (MUL* 2 A (INV PAR))(1//2))(MUL -2 V))))
  887.  
  888. (DEFUN F29P146
  889.        (C V A)
  890.        (MUL* 2
  891.          (POWER (MUL* A (INV 4)(INV PAR))(DIV V 2))
  892.          (KTFORK A V)))
  893.  
  894. (DEFUN KTFORK
  895.        (A V)
  896.        ((LAMBDA(Z)
  897.            (COND ((MAXIMA-INTEGERP V)(KMODBES Z V))
  898.              (T (SIMPKTF Z V))))
  899.     (POWER (MUL* A PAR)(1//2))))
  900.  
  901. (DEFUN DTFORD
  902.        (Z V)
  903.        (COND (((LAMBDA(INV4)
  904.               (WHITTINDTEST (ADD (DIV V 2) INV4) INV4))
  905.            (INV 4))
  906.           (PARCYL Z V))
  907.          (T (SIMPDTF Z V))))
  908.  
  909.  
  910. (DEFUN SIMPDTF
  911.        (Z V)
  912.        ((LAMBDA(INV2 POW)
  913.            (ADD (MUL* (POWER 2 (DIV (SUB V 1) 2))
  914.               Z
  915.               (GM (INV -2))
  916.               (INV (GM (MUL* V -1 INV2)))
  917.               POW
  918.               (HGFSIMP-EXEC (LIST (SUB INV2
  919.                            (DIV V
  920.                             2)))
  921.                     (LIST (DIV 3 2))
  922.                     (MUL* Z Z INV2)))
  923.             (MUL* (POWER 2 (DIV V 2))
  924.               (GM INV2)
  925.               POW
  926.               (INV (GM (SUB INV2 (MUL V INV2))))
  927.               (HGFSIMP-EXEC (LIST (MUL* V
  928.                            -1
  929.                            INV2))
  930.                     (LIST INV2)
  931.                     (MUL* Z Z INV2)))))
  932.     (1//2)
  933.     (POWER '$%E (MUL* Z Z (INV -4)))))
  934.  
  935. (DEFUN SIMPKTF
  936.        (Z V)
  937.        ((LAMBDA(DZ2)
  938.            (MUL* '$%PI
  939.              (1//2)
  940.              (INV (sin% (MUL V '$%PI)))
  941.              (SUB (MUL* (POWER  DZ2 (MUL -1 V))
  942.                    (INV (GM (SUB 1 V)))
  943.                    (HGFSIMP-EXEC NIL
  944.                          (LIST (SUB 1
  945.                             V))
  946.                          (MUL* Z
  947.                           Z
  948.                           (INV 4))))
  949.               (MUL* (POWER DZ2 V)
  950.                    (INV (GM (ADD V 1)))
  951.                    (HGFSIMP-EXEC NIL
  952.                          (LIST (ADD V
  953.                             1))
  954.                          (MUL* Z
  955.                           Z
  956.                           (INV 4)))))))
  957.     (DIV Z 2))) 
  958. ;dispatches according to the special functions involved in the laplace transformable expression
  959.  
  960. (DEFUN LT-SF-LOG
  961.        (U)
  962.        (PROG(L INDEX1 INDEX11 INDEX2 INDEX21 ARG1 ARG2 REST)
  963.         (COND ((SETQ L (TWOJ U))
  964.            (SETQ INDEX1
  965.              (CDRAS 'V1 L)
  966.              INDEX2
  967.              (CDRAS 'V2 L)
  968.              ARG1
  969.              (CDRAS 'W1 L)
  970.              ARG2
  971.              (CDRAS 'W2 L)
  972.              REST
  973.              (CDRAS 'U L))
  974.            (RETURN (LT2J REST ARG1 ARG2 INDEX1 INDEX2))))
  975.         (COND ((SETQ L (TWOH U))
  976.            (SETQ INDEX1
  977.              (CDRAS 'V1 L)
  978.              INDEX11
  979.              (CDRAS 'V11 L)
  980.              INDEX2
  981.              (CDRAS 'V2 L)
  982.              INDEX21
  983.              (CDRAS 'V21 L)
  984.              ARG1
  985.              (CDRAS 'W1 L)
  986.              ARG2
  987.              (CDRAS 'W2 L)
  988.              REST
  989.              (CDRAS 'U L))
  990.            (RETURN (FRACTEST REST
  991.                      ARG1
  992.                      ARG2
  993.                      INDEX1
  994.                      INDEX11
  995.                      INDEX2
  996.                      INDEX21
  997.                      '2HTJORY))))
  998.         (COND ((SETQ L (TWOY U))
  999.            (SETQ INDEX1
  1000.              (CDRAS 'V1 L)
  1001.              INDEX2
  1002.              (CDRAS 'V2 L)
  1003.              ARG1
  1004.              (CDRAS 'W1 L)
  1005.              ARG2
  1006.              (CDRAS 'W2 L)
  1007.              REST
  1008.              (CDRAS 'U L))
  1009.            (RETURN (FRACTEST REST
  1010.                      ARG1
  1011.                      ARG2
  1012.                      INDEX1
  1013.                      NIL
  1014.                      INDEX2
  1015.                      NIL
  1016.                      '2YTJ))))
  1017.         (COND ((SETQ L (TWOK U))
  1018.            (SETQ INDEX1
  1019.              (CDRAS 'V1 L)
  1020.              INDEX2
  1021.              (CDRAS 'V2 L)
  1022.              ARG1
  1023.              (CDRAS 'W1 L)
  1024.              ARG2
  1025.              (CDRAS 'W2 L)
  1026.              REST
  1027.              (CDRAS 'U L))
  1028.            (RETURN (FRACTEST REST
  1029.                      ARG1
  1030.                      ARG2
  1031.                      INDEX1
  1032.                      NIL
  1033.                      INDEX2
  1034.                      NIL
  1035.                      '2KTI))))
  1036.         (COND ((SETQ L (ONEKONEY U))
  1037.            (SETQ INDEX1
  1038.              (CDRAS 'V1 L)
  1039.              INDEX2
  1040.              (CDRAS 'V2 L)
  1041.              ARG1
  1042.              (CDRAS 'W1 L)
  1043.              ARG2
  1044.              (CDRAS 'W2 L)
  1045.              REST
  1046.              (CDRAS 'U L))
  1047.            (RETURN (FRACTEST REST
  1048.                      ARG1
  1049.                      ARG2
  1050.                      INDEX1
  1051.                      NIL
  1052.                      INDEX2
  1053.                      NIL
  1054.                      'KTIYTJ))))
  1055.         (COND ((SETQ L (ONEIONEJ U))
  1056.            (SETQ INDEX1
  1057.              (CDRAS 'V1 L)
  1058.              INDEX2
  1059.              (CDRAS 'V2 L)
  1060.              INDEX21
  1061.              (CDRAS 'V21 L)
  1062.              ARG1
  1063.              (MUL* (1FACT T T)(CDRAS 'W1 L))
  1064.              ARG2
  1065.              (CDRAS 'W2 L)
  1066.              REST
  1067.              (MUL* (1FACT NIL INDEX1)(CDRAS 'U L)))
  1068.            (RETURN (LT2J REST ARG1 ARG2 INDEX1 INDEX2))))
  1069.         (COND ((SETQ L (ONEIONEH U))
  1070.            (SETQ INDEX1
  1071.              (CDRAS 'V1 L)
  1072.              INDEX2
  1073.              (CDRAS 'V2 L)
  1074.              INDEX21
  1075.              (CDRAS 'V21 L)
  1076.              ARG1
  1077.              (MUL* (1FACT T T)(CDRAS 'W1 L))
  1078.              ARG2
  1079.              (CDRAS 'W2 L)
  1080.              REST
  1081.              (MUL* (1FACT NIL INDEX1)(CDRAS 'U L)))
  1082.            (RETURN (FRACTEST1 REST
  1083.                       ARG1
  1084.                       ARG2
  1085.                       INDEX1
  1086.                       INDEX2
  1087.                       INDEX21
  1088.                       'BESSHTJORY))))
  1089.         (COND ((SETQ L (ONEYONEJ U))
  1090.            (SETQ INDEX1
  1091.              (CDRAS 'V1 L)
  1092.              INDEX2
  1093.              (CDRAS 'V2 L)
  1094.              ARG1
  1095.              (CDRAS 'W1 L)
  1096.              ARG2
  1097.              (CDRAS 'W2 L)
  1098.              REST
  1099.              (CDRAS 'U L))
  1100.            (RETURN (FRACTEST1 REST
  1101.                       ARG2
  1102.                       ARG1
  1103.                       INDEX2
  1104.                       INDEX1
  1105.                       NIL
  1106.                       'BESSYTJ))))
  1107.         (COND ((SETQ L (ONEKONEJ U))
  1108.            (SETQ INDEX1
  1109.              (CDRAS 'V1 L)
  1110.              INDEX2
  1111.              (CDRAS 'V2 L)
  1112.              ARG1
  1113.              (CDRAS 'W1 L)
  1114.              ARG2
  1115.              (CDRAS 'W2 L)
  1116.              REST
  1117.              (CDRAS 'U L))
  1118.            (RETURN (FRACTEST1 REST
  1119.                       ARG2
  1120.                       ARG1
  1121.                       INDEX2
  1122.                       INDEX1
  1123.                       NIL
  1124.                       'BESSKTI))))
  1125.         (COND ((SETQ L (ONEHONEJ U))
  1126.            (SETQ INDEX1
  1127.              (CDRAS 'V1 L)
  1128.              INDEX11
  1129.              (CDRAS 'V11 L)
  1130.              INDEX2
  1131.              (CDRAS 'V2 L)
  1132.              ARG1
  1133.              (CDRAS 'W1 L)
  1134.              ARG2
  1135.              (CDRAS 'W2 L)
  1136.              REST
  1137.              (CDRAS 'U L))
  1138.            (RETURN (FRACTEST1 REST
  1139.                       ARG2
  1140.                       ARG1
  1141.                       INDEX2
  1142.                       INDEX1
  1143.                       INDEX11
  1144.                       'BESSHTJORY))))
  1145.         (COND ((SETQ L (ONEYONEH U))
  1146.            (SETQ INDEX1
  1147.              (CDRAS 'V1 L)
  1148.              INDEX2
  1149.              (CDRAS 'V2 L)
  1150.              INDEX11
  1151.              (CDRAS 'V21 L)
  1152.              ARG1
  1153.              (CDRAS 'W1 L)
  1154.              ARG2
  1155.              (CDRAS 'W2 L)
  1156.              REST
  1157.              (CDRAS 'U L))
  1158.            (RETURN (FRACTEST1 REST
  1159.                       ARG2
  1160.                       ARG1
  1161.                       INDEX2
  1162.                       INDEX1
  1163.                       INDEX11
  1164.                       'HTJORYYTJ))))
  1165.         (COND ((SETQ L (ONEKONEH U))
  1166.            (SETQ INDEX1
  1167.              (CDRAS 'V1 L)
  1168.              INDEX2
  1169.              (CDRAS 'V2 L)
  1170.              INDEX11
  1171.              (CDRAS 'V21 L)
  1172.              ARG1
  1173.              (CDRAS 'W1 L)
  1174.              ARG2
  1175.              (CDRAS 'W2 L)
  1176.              REST
  1177.              (CDRAS 'U L))
  1178.            (RETURN (FRACTEST1 REST
  1179.                       ARG2
  1180.                       ARG1
  1181.                       INDEX2
  1182.                       INDEX1
  1183.                       INDEX11
  1184.                       'HTJORYKTI))))
  1185.         (COND ((SETQ L (ONEIONEY U))
  1186.            (SETQ INDEX1
  1187.              (CDRAS 'V1 L)
  1188.              INDEX2
  1189.              (CDRAS 'V2 L)
  1190.              ARG1
  1191.              (MUL* (1FACT T T)(CDRAS 'W1 L))
  1192.              ARG2
  1193.              (CDRAS 'W2 L)
  1194.              REST
  1195.              (MUL* (1FACT NIL INDEX1)(CDRAS 'U L)))
  1196.            (RETURN (FRACTEST1 REST
  1197.                       ARG1
  1198.                       ARG2
  1199.                       INDEX1
  1200.                       INDEX2
  1201.                       NIL
  1202.                       'BESSYTJ))))
  1203.         (COND ((SETQ L (ONEIONEK U))
  1204.            (SETQ INDEX1
  1205.              (CDRAS 'V1 L)
  1206.              INDEX2
  1207.              (CDRAS 'V2 L)
  1208.              ARG1
  1209.              (MUL* (1FACT T T)(CDRAS 'W1 L))
  1210.              ARG2
  1211.              (CDRAS 'W2 L)
  1212.              REST
  1213.              (MUL* (1FACT NIL INDEX1)(CDRAS 'U L)))
  1214.            (RETURN (FRACTEST1 REST
  1215.                       ARG1
  1216.                       ARG2
  1217.                       INDEX1
  1218.                       INDEX2
  1219.                       NIL
  1220.                       'BESSKTI))))
  1221.         (COND ((SETQ L (ONEHSTRUVE U))
  1222.            (SETQ INDEX1
  1223.              (CDRAS 'V L)
  1224.              ARG1
  1225.              (CDRAS 'W L)
  1226.              REST
  1227.              (CDRAS 'U L))
  1228.            (RETURN (LT1HSTRUVE REST ARG1 INDEX1))))
  1229.         (COND ((SETQ L (ONELSTRUVE U))
  1230.            (SETQ INDEX1
  1231.              (CDRAS 'V L)
  1232.              ARG1
  1233.              (CDRAS 'W L)
  1234.              REST
  1235.              (CDRAS 'U L))
  1236.            (RETURN (LT1LSTRUVE REST ARG1 INDEX1))))
  1237.         (COND ((SETQ L (ONES U))
  1238.            (SETQ INDEX1
  1239.              (CDRAS 'V1 L)
  1240.              INDEX2
  1241.              (CDRAS 'V2 L)
  1242.              ARG1
  1243.              (CDRAS 'W L)
  1244.              REST
  1245.              (CDRAS 'U L))
  1246.            (RETURN (LT1S REST ARG1 INDEX1 INDEX2))))
  1247.         (COND ((SETQ L (ONESLOMMEL U))
  1248.            (SETQ INDEX1
  1249.              (CDRAS 'V1 L)
  1250.              INDEX2
  1251.              (CDRAS 'V2 L)
  1252.              ARG1
  1253.              (CDRAS 'W L)
  1254.              REST
  1255.              (CDRAS 'U L))
  1256.            (RETURN (FRACTEST2 REST
  1257.                       ARG1
  1258.                       INDEX1
  1259.                       INDEX2
  1260.                       'SLOMMEL))))
  1261.         (COND ((SETQ L (ONEY U))
  1262.            (SETQ INDEX1
  1263.              (CDRAS 'V L)
  1264.              ARG1
  1265.              (CDRAS 'W L)
  1266.              REST
  1267.              (CDRAS 'U L))
  1268.            (RETURN (LT1YREF REST ARG1 INDEX1))))
  1269.         (COND ((SETQ L (ONEK U))
  1270.            (SETQ INDEX1
  1271.              (CDRAS 'V L)
  1272.              ARG1
  1273.              (CDRAS 'W L)
  1274.              REST
  1275.              (CDRAS 'U L))
  1276.            (RETURN (FRACTEST2 REST
  1277.                       ARG1
  1278.                       INDEX1
  1279.                       NIL
  1280.                       'KTI))))
  1281.         (COND ((SETQ L (ONED U))
  1282.            (SETQ INDEX1
  1283.              (CDRAS 'V L)
  1284.              ARG1
  1285.              (CDRAS 'W L)
  1286.              REST
  1287.              (CDRAS 'U L))
  1288.            (RETURN (FRACTEST2 REST ARG1 INDEX1 NIL 'D))))
  1289.         (COND ((SETQ L (ONEGAMMAINCOMPLETE U))
  1290.            (SETQ ARG1
  1291.              (CDRAS 'W1 L)
  1292.              ARG2
  1293.              (CDRAS 'W2 L)
  1294.              REST
  1295.              (CDRAS 'U L))
  1296.            (RETURN (FRACTEST2 REST
  1297.                       ARG1
  1298.                       ARG2
  1299.                       NIL
  1300.                       'GAMMAINCOMPLETE))))
  1301.         (COND ((SETQ L (ONEKBATEMAN U))
  1302.            (SETQ INDEX1
  1303.              (CDRAS 'V L)
  1304.              ARG1
  1305.              (CDRAS 'W L)
  1306.              REST
  1307.              (CDRAS 'U L))
  1308.            (RETURN (FRACTEST2 REST
  1309.                       ARG1
  1310.                       INDEX1
  1311.                       NIL
  1312.                       'KBATEMAN))))
  1313.         (COND ((SETQ L (ONEJ U))
  1314.            (SETQ INDEX1
  1315.              (CDRAS 'V L)
  1316.              ARG1
  1317.              (CDRAS 'W L)
  1318.              REST
  1319.              (CDRAS 'U L))
  1320.            (RETURN (LT1J REST ARG1 INDEX1))))
  1321.         (COND ((SETQ L (ONEGAMMAGREEK U))
  1322.            (SETQ ARG1
  1323.              (CDRAS 'W1 L)
  1324.              ARG2
  1325.              (CDRAS 'W2 L)
  1326.              REST
  1327.              (CDRAS 'U L))
  1328.            (RETURN (LT1GAMMAGREEK REST ARG1 ARG2))))
  1329.         (COND ((SETQ L (ONEH U))
  1330.            (SETQ INDEX1
  1331.              (CDRAS 'V1 L)
  1332.              INDEX11
  1333.              (CDRAS 'V2 L)
  1334.              ARG1
  1335.              (CDRAS 'W L)
  1336.              REST
  1337.              (CDRAS 'U L))
  1338.            (RETURN (FRACTEST2 REST
  1339.                       ARG1
  1340.                       INDEX1
  1341.                       INDEX11
  1342.                       'HTJORY))))
  1343.         (COND ((SETQ L (ONEM U))
  1344.            (SETQ INDEX1
  1345.              (CDRAS 'V1 L)
  1346.              INDEX11
  1347.              (CDRAS 'V2 L)
  1348.              ARG1
  1349.              (CDRAS 'W L)
  1350.              REST
  1351.              (CDRAS 'U L))
  1352.            (RETURN (LT1M REST ARG1 INDEX1 INDEX11))))
  1353.         (COND ((SETQ L (ONEL U))
  1354.            (SETQ INDEX1
  1355.              (CDRAS 'V1 L)
  1356.              INDEX11
  1357.              (CDRAS 'V2 L)
  1358.              ARG1
  1359.              (CDRAS 'W L)
  1360.              REST
  1361.              (CDRAS 'U L))
  1362.            (RETURN (INTEGERTEST REST
  1363.                     ARG1
  1364.                     INDEX1
  1365.                     INDEX11
  1366.                     'L))))
  1367.         (COND ((SETQ L (ONEC U))
  1368.            (SETQ INDEX1
  1369.              (CDRAS 'V1 L)
  1370.              INDEX11
  1371.              (CDRAS 'V2 L)
  1372.              ARG1
  1373.              (CDRAS 'W L)
  1374.              REST
  1375.              (CDRAS 'U L))
  1376.            (RETURN (INTEGERTEST REST
  1377.                     ARG1
  1378.                     INDEX1
  1379.                     INDEX11
  1380.                     'C))))
  1381.         (COND ((SETQ L (ONET U))
  1382.            (SETQ INDEX1
  1383.              (CDRAS 'V1 L)
  1384.              ARG1
  1385.              (CDRAS 'W L)
  1386.              REST
  1387.              (CDRAS 'U L))
  1388.            (RETURN (INTEGERTEST REST
  1389.                     ARG1
  1390.                     INDEX1
  1391.                     NIL
  1392.                     'T))))
  1393.         (COND ((SETQ L (ONEU U))
  1394.            (SETQ INDEX1
  1395.              (CDRAS 'V1 L)
  1396.              ARG1
  1397.              (CDRAS 'W L)
  1398.              REST
  1399.              (CDRAS 'U L))
  1400.            (RETURN (INTEGERTEST REST
  1401.                     ARG1
  1402.                     INDEX1
  1403.                     NIL
  1404.                     'U))))
  1405.         (COND ((SETQ L (ONEHE U))
  1406.            (SETQ INDEX1
  1407.              (CDRAS 'V1 L)
  1408.              ARG1
  1409.              (CDRAS 'W L)
  1410.              REST
  1411.              (CDRAS 'U L))
  1412.            (RETURN (INTEGERTEST REST
  1413.                     ARG1
  1414.                     INDEX1
  1415.                     NIL
  1416.                     'HE))))
  1417.         (COND ((SETQ L (HYP-ONEP U))
  1418.            (SETQ INDEX1
  1419.              (CDRAS 'V1 L)
  1420.              INDEX11
  1421.              (CDRAS 'V2 L)
  1422.              ARG1
  1423.              (CDRAS 'W L)
  1424.              REST
  1425.              (CDRAS 'U L))
  1426.            (RETURN (LT1P REST ARG1 INDEX1 INDEX11))))
  1427.         (COND ((SETQ L (ONEPJAC U))
  1428.            (SETQ INDEX1
  1429.              (CDRAS 'V1 L)
  1430.              INDEX2
  1431.              (CDRAS 'V2 L)
  1432.              INDEX21
  1433.              (CDRAS 'V3 L)
  1434.              ARG1
  1435.              (CDRAS 'W L)
  1436.              REST
  1437.              (CDRAS 'U L))
  1438.            (RETURN (PJACTEST REST
  1439.                      ARG1
  1440.                      INDEX1
  1441.                      INDEX2
  1442.                      INDEX21))))
  1443.         (COND ((SETQ L (ONEQ U))
  1444.            (SETQ INDEX1
  1445.              (CDRAS 'V1 L)
  1446.              INDEX11
  1447.              (CDRAS 'V2 L)
  1448.              ARG1
  1449.              (CDRAS 'W L)
  1450.              REST
  1451.              (CDRAS 'U L))
  1452.            (RETURN (LT1Q REST ARG1 INDEX1 INDEX11))))
  1453.         (COND ((SETQ L (ONEP0 U))
  1454.            (SETQ INDEX1
  1455.              (CDRAS 'V1 L)
  1456.              INDEX11
  1457.              0
  1458.              ARG1
  1459.              (CDRAS 'W L)
  1460.              REST
  1461.              (CDRAS 'U L))
  1462.            (RETURN (LT1P REST ARG1 INDEX1 INDEX11))))
  1463.         (COND ((SETQ L (ONEW U))
  1464.            (SETQ INDEX1
  1465.              (CDRAS 'V1 L)
  1466.              INDEX11
  1467.              (CDRAS 'V2 L)
  1468.              ARG1
  1469.              (CDRAS 'W L)
  1470.              REST
  1471.              (CDRAS 'U L))
  1472.            (RETURN (WHITTEST REST ARG1 INDEX1 INDEX11))))
  1473.         (COND ((SETQ L (ONEJ^2 U))
  1474.            (SETQ INDEX1
  1475.              (CDRAS 'V L)
  1476.              ARG1
  1477.              (CDRAS 'W L)
  1478.              REST
  1479.              (CDRAS 'U L))
  1480.            (RETURN (LT1J^2 REST ARG1 INDEX1))))
  1481.         (COND ((SETQ L (ONEH^2 U))
  1482.            (SETQ INDEX1
  1483.              (CDRAS 'V1 L)
  1484.              INDEX11
  1485.              (CDRAS 'V2 L)
  1486.              ARG1
  1487.              (CDRAS 'W L)
  1488.              REST
  1489.              (CDRAS 'U L))
  1490.            (RETURN (FRACTEST REST
  1491.                      ARG1
  1492.                      ARG1
  1493.                      INDEX1
  1494.                      INDEX11
  1495.                      INDEX1
  1496.                      INDEX11
  1497.                      '2HTJORY))))
  1498.         (COND ((SETQ L (ONEY^2 U))
  1499.            (SETQ INDEX1
  1500.              (CDRAS 'V L)
  1501.              ARG1
  1502.              (CDRAS 'W L)
  1503.              REST
  1504.              (CDRAS 'U L))
  1505.            (RETURN (FRACTEST REST
  1506.                      ARG1
  1507.                      ARG1
  1508.                      INDEX1
  1509.                      NIL
  1510.                      INDEX1
  1511.                      NIL
  1512.                      '2YTJ))))
  1513.         (COND ((SETQ L (ONEK^2 U))
  1514.            (SETQ INDEX1
  1515.              (CDRAS 'V L)
  1516.              ARG1
  1517.              (CDRAS 'W L)
  1518.              REST
  1519.              (CDRAS 'U L))
  1520.            (RETURN (FRACTEST REST
  1521.                      ARG1
  1522.                      ARG1
  1523.                      INDEX1
  1524.                      NIL
  1525.                      INDEX1
  1526.                      NIL
  1527.                      '2KTI))))
  1528.         (COND ((SETQ L (TWOI U))
  1529.            (SETQ INDEX1
  1530.              (CDRAS 'V1 L)
  1531.              INDEX2
  1532.              (CDRAS 'V2 L)
  1533.              ARG1
  1534.              (MUL* (1FACT T T)(CDRAS 'W1 L))
  1535.              ARG2
  1536.              (MUL* (1FACT T T) (CDRAS 'W2 L))
  1537.              REST
  1538.              (MUL* (1FACT NIL INDEX1)
  1539.                   (1FACT NIL INDEX2)
  1540.                   (CDRAS 'U L)))
  1541.            (RETURN (LT2J REST ARG1 ARG2 INDEX1 INDEX2))))
  1542.         (COND ((SETQ L (ONEI U))
  1543.            (SETQ INDEX1
  1544.              (CDRAS 'V L)
  1545.              ARG1
  1546.              (MUL* (1FACT T T)(CDRAS 'W L))
  1547.              REST
  1548.              (MUL* (1FACT NIL INDEX1)(CDRAS 'U L)))
  1549.            (RETURN (LT1J REST ARG1 INDEX1))))
  1550.         (COND ((SETQ L (ONEI^2 U))
  1551.            (SETQ INDEX1
  1552.              (CDRAS 'V L)
  1553.              ARG1
  1554.              (MUL* (1FACT T T)(CDRAS 'W L))
  1555.              REST
  1556.              (MUL* (1FACT NIL INDEX1)(CDRAS 'U L)))
  1557.            (RETURN (LT1J^2 REST ARG1 INDEX1))))
  1558.         (COND ((SETQ L (ONERF U))
  1559.            (SETQ ARG1 (CDRAS 'W L) REST (CDRAS 'U L))
  1560.            (RETURN (LT1ERF REST ARG1))))
  1561.         (COND ((SETQ L (ONELOG U))
  1562.            (SETQ ARG1 (CDRAS 'W L) REST (CDRAS 'U L))
  1563.            (RETURN (LT1LOG REST ARG1))))
  1564.         (COND ((SETQ L (ONERFC U))
  1565.            (SETQ ARG1 (CDRAS 'W L) REST (CDRAS 'U L))
  1566.            (RETURN (FRACTEST2 REST ARG1 NIL NIL 'ERFC))))
  1567.         (COND ((SETQ L (ONEEI U))
  1568.            (SETQ ARG1 (CDRAS 'W L) REST (CDRAS 'U L))
  1569.            (RETURN (FRACTEST2 REST ARG1 NIL NIL 'EI))))
  1570.         (COND ((SETQ L (ONEKELLIPTIC U))
  1571.            (SETQ ARG1 (CDRAS 'W L) REST (CDRAS 'U L))
  1572.            (RETURN (LT1KELLIPTIC REST ARG1))))
  1573.         (COND ((SETQ L (ONEE U))
  1574.            (SETQ ARG1 (CDRAS 'W L) REST (CDRAS 'U L))
  1575.            (RETURN (LT1E REST ARG1))))
  1576.         (COND ((SETQ L (ARBPOW1 U))
  1577.            (SETQ ARG1
  1578.              (CDRAS 'U L)
  1579.              ARG2
  1580.              (CDRAS 'C L)
  1581.              INDEX1
  1582.              (CDRAS 'V L))
  1583.            (RETURN (MUL ARG2 (LT-ARBPOW ARG1 INDEX1)))))
  1584.         (RETURN 'OTHER-J-CASES-NEXT)))
  1585.  
  1586. (DEFUN LT-ARBPOW
  1587.        (EXP POW)
  1588.        (COND ((OR (EQ EXP VAR)(ZERP POW))(F1P137TEST POW))))
  1589.  
  1590. (DEFUN FRACTEST
  1591.        (R A1 A2 I1 I11 I2 I21 FLG)
  1592.        (COND ((OR (AND (EQUAL (CAAR I1) 'RAT)
  1593.                (EQUAL (CAAR I2) 'RAT))
  1594.           (EQ FLG '2HTJORY))
  1595.           (SENDEXEC R
  1596.             (COND ((EQ FLG '2YTJ)
  1597.                    (MUL (YTJ I1 A1)(YTJ I2 A2)))
  1598.                   ((EQ FLG '2HTJORY)
  1599.                    (MUL (HTJORY I1 I11 A1)
  1600.                     (HTJORY I2 I21 A2)))
  1601.                   ((EQ FLG 'KTIYTJ)
  1602.                    (MUL (KTI I1 A1)(YTJ I2 A2)))
  1603.                   ((EQ FLG '2KTI)
  1604.                    (MUL (KTI I1 A1)(KTI I2 A2))))))
  1605.          (T 'PRODUCT-OF-Y-WITH-NOFRACT-INDICES)))
  1606.  
  1607. (DEFUN FRACTEST1
  1608.        (R A1 A2 I1 I2 I FLG)
  1609.        (COND ((OR (EQUAL (CAAR I2) 'RAT)(EQ FLG 'BESSHTJORY))
  1610.           (SENDEXEC R
  1611.             (COND ((EQ FLG 'BESSYTJ)
  1612.                    (MUL (BESS I1 A1 'J)
  1613.                     (YTJ I2 A2)))
  1614.                   ((EQ FLG 'BESSHTJORY)
  1615.                    (MUL (BESS I1 A1 'J)
  1616.                     (HTJORY I2 I A2)))
  1617.                   ((EQ FLG 'HTJORYYTJ)
  1618.                    (MUL (HTJORY I1 I A1)
  1619.                     (YTJ I2 A2)))
  1620.                   ((EQ FLG 'BESSKTI)
  1621.                    (MUL (BESS I1 A1 'J)
  1622.                     (KTI I2 A2)))
  1623.                   ((EQ FLG 'HTJORYKTI)
  1624.                    (MUL (HTJORY I1 I A1)
  1625.                     (KTI I2 A2))))))
  1626.          (T 'PRODUCT-OF-I-Y-OF-NOFRACT-INDEX)))
  1627.  
  1628. (DEFUN FRACTEST2
  1629.        (R A1 I1 I11 FLG)
  1630.        (COND ((OR (EQUAL (CAAR I1) 'RAT)
  1631.           (EQ FLG 'D)
  1632.           (EQ FLG 'KBATEMAN)
  1633.           (EQ FLG 'GAMMAINCOMPLETE)
  1634.           (EQ FLG 'HTJORY)
  1635.           (EQ FLG 'ERFC)
  1636.           (EQ FLG 'EI)
  1637.           (EQ FLG 'SLOMMEL))
  1638.           (SENDEXEC R
  1639.             (COND ((EQ FLG 'YTJ)(YTJ I1 A1))
  1640.                   ((EQ FLG 'HTJORY)
  1641.                    (HTJORY I1 I11 A1))
  1642.                   ((EQ FLG 'D)(DTW I1 A1))
  1643.                   ((EQ FLG 'KBATEMAN)
  1644.                    (KBATEMANTW I1 A1))
  1645.                   ((EQ FLG 'GAMMAINCOMPLETE)
  1646.                    (GAMMAINCOMPLETETW A1 I1))
  1647.                   ((EQ FLG 'KTI)(KTI I1 A1))
  1648.                   ((EQ FLG 'ERFC)(ERFCTD A1))
  1649.                   ((EQ FLG 'EI)
  1650.                    (EITGAMMAINCOMPLETE A1))
  1651.                   ((EQ FLG 'SLOMMEL)
  1652.                    (SLOMMELTJANDY I1 I11 A1)))))
  1653.          (T 'Y-OF-NOFRACT-INDEX)))
  1654.  
  1655. (DEFUN LT1YREF
  1656.        (REST ARG1 INDEX1)
  1657.        (COND ((MAXIMA-INTEGERP INDEX1)(LT1Y REST ARG1  INDEX1))
  1658.          (T (FRACTEST2 REST ARG1 INDEX1 NIL 'YTJ))))
  1659.  
  1660. (DEFUN PJACTEST
  1661.        (REST ARG INDEX1 INDEX2 INDEX3)
  1662.        (COND ((MAXIMA-INTEGERP INDEX1)
  1663.           (LT-LTP 'ONEPJAC
  1664.               REST
  1665.               ARG
  1666.               (LIST INDEX1 INDEX2 INDEX3)))
  1667.          (T 'IND-SHOULD-BE-AN-INTEGER-IN-POLYS)))
  1668.  
  1669. (DEFUN EQRAT(A)(COND ((NUMBERP A) NIL)(T (EQUAL (CAAR A) 'RAT)))) 
  1670.  
  1671. (DEFUN INTEGERTEST
  1672.        (R ARG I1 I2 FLG)
  1673.        (COND ((MAXIMA-INTEGERP I1)(DISPATCHPOLTRANS R ARG I1 I2 FLG))
  1674.          (T 'INDEX-SHOULD-BE-AN-INTEGER-IN-POLYS)))
  1675.  
  1676. (DEFUN DISPATCHPOLTRANS
  1677.        (R X I1 I2 FLG)
  1678.        (SENDEXEC R
  1679.          (COND ((EQ FLG 'L)(LTW X I1 I2))
  1680.                ((EQ FLG 'HE)(HETD X I1))
  1681.                ((EQ FLG 'C)(CTPJAC X I1 I2))
  1682.                ((EQ FLG 'T)(TTPJAC X I1))
  1683.                ((EQ FLG 'U)(UTPJAC X I1)))))
  1684.  
  1685. (DEFUN SENDEXEC(R A)(DISTREXECINIT ($EXPAND (MUL (INIT R) A)))) 
  1686.  
  1687. (DEFUN WHITTEST
  1688.        (R A I1 I2)
  1689.        (COND ((WHITTINDTEST I1 I2) 'FORMULA-FOR-CONFL-NEEDED)
  1690.          (T (DISTREXECINIT ($EXPAND (MUL (INIT R)
  1691.                          (WTM A I1 I2)))))))
  1692.  
  1693. (DEFUN WHITTINDTEST
  1694.        (I1 I2)
  1695.        (OR (MAXIMA-INTEGERP (ADD I2 I2))
  1696.        (NEGINP (SUB (SUB (1//2) I2) I1))
  1697.        (NEGINP (SUB (ADD (1//2) I2) I1))))
  1698.  
  1699. (DEFUN INIT(R)(MUL* R (POWER '$%E (MUL* -1 VAR PAR))))
  1700.  
  1701. (DEFUN LTW
  1702.        (X N A)
  1703.        ((LAMBDA(DIVA2)
  1704.            (MUL* (POWER -1 N)
  1705.              (INV (FACTORIAL N))
  1706.              (POWER X (SUB (INV -2) DIVA2))
  1707.              (POWER '$%E (DIV X 2))
  1708.              (WWHIT X (ADD (1//2) DIVA2 N) DIVA2)))
  1709.     (DIV A 2)))
  1710.  
  1711. (DEFUN CTPJAC
  1712.        (X N V)
  1713.        ((LAMBDA(INV2)
  1714.            (MUL* (GM (ADD V V N))
  1715.              (INV (GM (ADD V V)))
  1716.              (GM (ADD INV2 V))
  1717.              (INV (GM (ADD V INV2 N)))
  1718.              (PJAC X N (SUB V INV2)(SUB V INV2))))
  1719.     (1//2)))
  1720.  
  1721. (DEFUN TTPJAC
  1722.        (X N)
  1723.        ((LAMBDA(INV2)
  1724.            (MUL* (FACTORIAL N)
  1725.              (GM INV2)
  1726.              (INV (GM (ADD INV2 N)))
  1727.              (PJAC X N (MUL -1 INV2)(MUL -1 INV2))))
  1728.     (1//2)))
  1729.  
  1730. (DEFUN UTPJAC
  1731.        (X N)
  1732.        ((LAMBDA(INV2)
  1733.            (MUL* (FACTORIAL (ADD N 1))
  1734.              INV2
  1735.              (GM INV2)
  1736.              (INV (GM (ADD INV2 N 1)))
  1737.              (PJAC X N INV2 INV2)))
  1738.     (1//2)))
  1739.  
  1740. (DEFUN HETD(X N)(MUL* (POWER '$%E (MUL* X X (INV 4)))(PARCYL X N)))
  1741.  
  1742. (DEFUN ERFCTD
  1743.        (X)
  1744.        ((LAMBDA(INV2)
  1745.            (MUL* (POWER 2 INV2)
  1746.              (POWER '$%PI (MUL* -1 INV2))
  1747.              (POWER '$%E (MUL* -1 INV2 X X))
  1748.              (PARCYL (MUL* (POWER 2 INV2) X) -1)))
  1749.     (1//2)))
  1750.  
  1751. (DEFUN EITGAMMAINCOMPLETE(X)(MUL* -1 (GMINC 0 (MUL -1 X))))
  1752.  
  1753. (DEFUN SLOMMELTJANDY
  1754.        (M N Z)
  1755.        ((LAMBDA(ARG)
  1756.            (ADD (LITTLESLOMMEL M N Z)
  1757.             (MUL* (POWER 2 (SUB M 1))
  1758.               (GM (DIV (SUB (ADD M 1) N) 2))
  1759.               (GM (DIV (ADD M N 1) 2))
  1760.               (SUB (MUL* (sin% ARG)(BESS N Z 'J))
  1761.                    (MUL* (COS% ARG)(BESS N Z 'Y))))))
  1762.     (MUL* (1//2) '$%PI (SUB M N))))
  1763.  
  1764. (DEFUN WTM
  1765.        (A I1 I2)
  1766.        (ADD (MUL* (GM (MUL -2 I2))
  1767.           (MWHIT A I1 I2)
  1768.           (INV (GM (SUB (SUB (1//2) I2) I1))))
  1769.         (MUL* (GM (ADD I2 I2))
  1770.           (MWHIT A I1 (MUL -1 I2))
  1771.           (INV (GM (SUB (ADD (1//2) I2) I1))))))
  1772.  
  1773. (DEFUN GAMMAINCOMPLETETW
  1774.        (A X)
  1775.        (MUL* (POWER X (DIV (SUB A 1) 2))
  1776.          (POWER '$%E (DIV X -2))
  1777.          (WWHIT X (DIV (SUB A 1) 2)(DIV A 2))))
  1778.  
  1779. (DEFUN DISTREXECINIT (FUN)
  1780.        (COND ((EQUAL (CAAR FUN) 'MPLUS) (DISTREXEC (CDR FUN)))
  1781.          (T (HYPGEO-EXEC FUN VAR PAR))))
  1782.  
  1783. (DEFUN DISTRDEFEXECINIT (FUN)
  1784.        (COND ((EQUAL (CAAR FUN) 'MPLUS) (DISTRDEFEXEC (CDR FUN)))
  1785.          (T (DEFEXEC FUN VAR))))
  1786.  
  1787. (DEFUN DISTREXEC (FUN)
  1788.        (COND ((NULL FUN) 0)
  1789.          (T (ADD (HYPGEO-EXEC (CAR FUN) VAR PAR)
  1790.              (DISTREXEC (CDR FUN))))))
  1791.  
  1792. (DEFUN DISTRDEFEXEC (FUN)
  1793.        (COND ((NULL FUN) 0)
  1794.          (T (ADD (DEFEXEC (CAR FUN) VAR)
  1795.              (DISTRDEFEXEC (CDR FUN))))))
  1796.  
  1797. (DEFUN YTJ (I A)
  1798.        (SUB (MUL* (BESS I A 'J)(LIST '(%COT) (MUL I '$%PI)))
  1799.         (MUL* (BESS (MUL -1 I) A 'J)(INV (sin% (MUL I '$%PI))))))
  1800.  
  1801. (DEFUN DTW (I A)
  1802.        (MUL* (POWER 2 (ADD (DIV I 2)(INV 4)))
  1803.          (POWER A (INV -2))
  1804.          (WWHIT (MUL* A A (1//2))
  1805.             (ADD (DIV I 2)(INV 4))
  1806.             (INV 4))))
  1807.  
  1808. (DEFUN KBATEMANTW (I A)
  1809.        ((LAMBDA(IND)
  1810.            (DIV (WWHIT (ADD A A) IND (1//2))
  1811.             (GM (ADD IND 1))))
  1812.     (DIV 1 2)))
  1813.  
  1814. (DEFUN KTI
  1815.        (I A)
  1816.        (MUL* '$%PI
  1817.          (1//2)
  1818.          (INV (sin% (MUL I '$%PI)))
  1819.          (SUB (BESS (MUL -1 I) A 'I)(BESS I A 'I))))
  1820.  
  1821. (DEFUN 1FACT
  1822.        (FLG V)
  1823.        (POWER '$%E
  1824.           (MUL* '$%PI
  1825.             '$%I
  1826.             (1//2)
  1827.             (COND (FLG 1)(T (MUL -1 V))))))
  1828.  
  1829. (DEFUN BESSY(V Z)(LIST '(MQAPPLY)(LIST '($%Y ARRAY) V) Z))
  1830.  
  1831. (DEFUN KMODBES(Z V)(LIST '(MQAPPLY)(LIST '($%K ARRAY) V)  Z))
  1832.  
  1833.  
  1834.  
  1835. (DEFUN TAN%(ARG)(LIST  '(%TAN) ARG))
  1836.  
  1837. (DEFUN DESJY
  1838.        (V Z FLG)
  1839.        (COND ((EQ FLG 'J)(BESS V Z 'J))(T (BESSY V Z))))
  1840.  
  1841. (DEFUN NUMJORY
  1842.        (V SORT Z FLG)
  1843.        (COND ((EQUAL SORT 1)
  1844.           (SUB (DESJY (MUL -1 V) Z FLG)
  1845.            (MUL* (POWER '$%E (MUL* -1 V '$%PI '$%I))
  1846.             (DESJY V Z FLG))))
  1847.          (T (SUB (MUL* (POWER '$%E (MUL* V '$%PI '$%I))
  1848.               (DESMJY V Z FLG))
  1849.              (DESMJY (MUL -1 V) Z FLG)))))
  1850.  
  1851. (DEFUN DESMJY
  1852.        (V Z FLG)
  1853.        (COND ((EQ FLG 'J)(BESS V Z 'J))(T (MUL -1 (BESSY V Z)))))
  1854.  
  1855. (DEFUN HTJORY
  1856.        (V SORT Z)
  1857.        (COND ((EQUAL (CAAR V) 'RAT)
  1858.           (DIV (NUMJORY V SORT Z 'J)
  1859.            (MUL* '$%I (SIN% (MUL V '$%PI)))))
  1860.          (T (DIV (NUMJORY V SORT Z 'Y)(SIN% (MUL V '$%PI)))))) 
  1861. ;expert on l.t. expressions containing one bessel function of the first kind
  1862.  
  1863. (DEFUN LT1J(REST ARG INDEX)(LT-LTP 'ONEJ REST ARG INDEX))
  1864.  
  1865. (DEFUN LT1Y(REST ARG INDEX)(LT-LTP 'ONEY REST ARG INDEX))
  1866.  
  1867. (DEFUN LT2J
  1868.        (REST ARG1 ARG2 INDEX1 INDEX2)
  1869.        (COND ((NOT (EQUAL ARG1 ARG2))
  1870.           'PRODUCT-OF-BESSEL-WITH-DIFFERENT-ARGS)
  1871.          (T (LT-LTP 'TWOJ
  1872.             REST
  1873.             ARG1
  1874.             (LIST 'LIST INDEX1 INDEX2)))))
  1875.  
  1876. (DEFUN LT1J^2
  1877.        (REST ARG INDEX)
  1878.        (LT-LTP 'TWOJ REST ARG (LIST 'LIST INDEX INDEX)))
  1879.  
  1880. (DEFUN LT1GAMMAGREEK
  1881.        (REST ARG1 ARG2)
  1882.        (LT-LTP 'GAMMAGREEK REST ARG2 ARG1))
  1883.  
  1884. (DEFUN LT1M(R A I1 I2)(LT-LTP 'ONEM R A (LIST I1 I2)))
  1885.  
  1886. (DEFUN LT1P(R A I1 I2)(LT-LTP 'HYP-ONEP R A (LIST I1 I2)))
  1887.  
  1888. (DEFUN LT1Q(R A I1 I2)(LT-LTP 'ONEQ R A (LIST I1 I2)))
  1889.  
  1890. (DEFUN LT1ERF(REST ARG)(LT-LTP 'ONERF REST ARG NIL))
  1891.  
  1892. (DEFUN LT1LOG(REST ARG)(LT-LTP 'ONELOG REST ARG NIL))
  1893.  
  1894. (DEFUN LT1KELLIPTIC(REST ARG)(LT-LTP 'ONEKELLIPTIC REST ARG NIL))
  1895.  
  1896. (DEFUN LT1E(REST ARG)(LT-LTP 'ONEE REST ARG NIL))
  1897.  
  1898. (DEFUN LT1HSTRUVE(REST ARG1 INDEX1)(LT-LTP 'HS REST ARG1 INDEX1))
  1899.  
  1900. (DEFUN LT1LSTRUVE(REST ARG1 INDEX1)(LT-LTP 'HL REST ARG1 INDEX1))
  1901.  
  1902. (DEFUN LT1S
  1903.        (REST ARG1 INDEX1 INDEX2)
  1904.        (LT-LTP 'S REST ARG1 (LIST INDEX1 INDEX2)))
  1905.  
  1906. (DEFUN HSTF
  1907.        (V Z)
  1908.        (PROG(D32)
  1909.         (SETQ D32 (DIV 3 2))
  1910.         (RETURN (LIST (MUL* (POWER (DIV Z 2)(ADD V 1))
  1911.                 (INV (GM D32))
  1912.                 (INV (GM (ADD V D32)))
  1913.                 (INV (GM (ADD V D32))))
  1914.               (LIST 'FPQ
  1915.                 (LIST 1 2)
  1916.                 (LIST 1)
  1917.                 (LIST D32 (ADD V D32))
  1918.                 (MUL* (INV -4) Z Z))))))
  1919.  
  1920. (DEFUN LSTF
  1921.        (V Z)
  1922.        (PROG(HST)
  1923.         (RETURN (LIST (MUL* (POWER '$%E
  1924.                       (MUL* (DIV (ADD V 1)
  1925.                          -2)
  1926.                         '$%PI
  1927.                         '$%I))
  1928.                    (CAR (SETQ HST
  1929.                       (HSTF V
  1930.                         (MUL* Z
  1931.                              (POWER '$%E
  1932.                                 (MUL*
  1933.                                  (1//2)
  1934.                                  '$%I
  1935.                                  '$%PI)))))))
  1936.               (CADR HST)))))
  1937.  
  1938. (DEFUN STF
  1939.        (M N Z)
  1940.        (LIST (MUL* (POWER Z (ADD M 1))
  1941.            (INV (SUB (ADD M 1) N))
  1942.            (INV (ADD M N 1)))
  1943.          (LIST 'FPQ
  1944.            (LIST 1 2)
  1945.            (LIST 1)
  1946.            (LIST (DIV (SUB (ADD M 3) N) 2)
  1947.              (DIV (ADD* M N 3) 2))
  1948.            (MUL* (INV -4) Z Z))))
  1949.  
  1950. (DEFUN LT-LTP
  1951.        (FLG REST ARG INDEX)
  1952.        (PROG(index1 index2 ARGL CONST L L1)
  1953.         (COND ((OR (ZERP INDEX)
  1954.                (EQ FLG 'ONERF)
  1955.                (EQ FLG 'ONEKELLIPTIC)
  1956.                (EQ FLG 'ONEE)
  1957.                (EQ FLG 'ONEPJAC)
  1958.                (EQ FLG 'D)
  1959.                (EQ FLG 'S)
  1960.                (EQ FLG 'HS)
  1961.                (EQ FLG 'LS)
  1962.                (EQ FLG 'ONEM)
  1963.                (EQ FLG 'ONEQ)
  1964.                (EQ FLG 'GAMMAGREEK)
  1965.                (EQ FLG 'ASIN)
  1966.                (EQ FLG 'ATAN))
  1967.            (GO LABL)))
  1968.         (COND ((OR (EQ FLG 'HYP-ONEP)(EQ FLG 'ONELOG))
  1969.            (GO LABL1)))
  1970.         (cond ((not (consp index)) (go lab)))
  1971.         (COND ((NOT (EQ (CAR INDEX) 'LIST))(GO LAB)))
  1972.         (COND ((ZERP (SETQ INDEX1 (CADR INDEX)))(GO LA)))
  1973.         (COND ((EQ (CHECKSIGNTM (SIMPLIFYA (INV (SETQ INDEX1
  1974.                               (CADR
  1975.                                INDEX)))
  1976.                            NIL))
  1977.                '$NEGATIVE)
  1978.            (SETQ INDEX1
  1979.              (MUL -1 INDEX1)
  1980.              REST
  1981.              (MUL* (POWER -1 INDEX1) REST))))
  1982.         LA
  1983.         (COND ((ZERP (SETQ INDEX2 (CADDR INDEX)))(GO LA2)))
  1984.         (COND ((EQ (CHECKSIGNTM (SIMPLIFYA (INV (SETQ INDEX2
  1985.                               (CADDR
  1986.                                INDEX)))
  1987.                            NIL))
  1988.                '$NEGATIVE)
  1989.            (SETQ INDEX2
  1990.              (MUL -1 INDEX2)
  1991.              REST
  1992.              (MUL* (POWER -1 INDEX2) REST))))
  1993.         LA2
  1994.         (SETQ INDEX (LIST INDEX1 INDEX2))
  1995.         (GO LABL)
  1996.         LAB
  1997.         (COND ((AND (EQ (CHECKSIGNTM (SIMPLIFYA (INV INDEX)
  1998.                             NIL))
  1999.                 '$NEGATIVE)
  2000.             (MAXIMA-INTEGERP INDEX))
  2001.            (SETQ INDEX (MUL -1 INDEX))
  2002.            (SETQ REST (MUL (POWER -1 INDEX) REST))))
  2003.         LABL
  2004.         (SETQ ARGL (F+C ARG))
  2005.         (SETQ CONST (CDRAS 'C ARGL) ARG (CDRAS 'F ARGL))
  2006.         (COND ((NULL CONST)(GO LABL1)))
  2007.         (COND ((NOT (EQ (CHECKSIGNTM (SIMPLIFYA (POWER CONST
  2008.                                2)
  2009.                             NIL))
  2010.                 '$ZERO))
  2011.            (RETURN 'PROP4-TO-BE-APPLIED)))
  2012.         LABL1
  2013.         (COND ((EQ FLG 'ONEY)(RETURN (LTY REST ARG INDEX))))
  2014.         (COND ((SETQ L
  2015.              (D*X^M*%E^A*X ($FACTOR (MUL* REST
  2016.                              (CAR (SETQ
  2017.                                L1
  2018.                                (REF
  2019.                                 FLG
  2020.                                 INDEX
  2021.                                 ARG)))))))
  2022.            (RETURN (%$ETEST L L1))))
  2023.         (RETURN 'OTHER-CA-LATER)))
  2024.  
  2025. (DEFUN LTY
  2026.        (REST ARG INDEX)
  2027.        (PROG(l)
  2028.         (COND ((SETQ L (D*X^M*%E^A*X REST))
  2029.            (RETURN (EXECFY L ARG INDEX))))
  2030.         (RETURN 'FAIL-IN-LTY)))
  2031.  
  2032. (DEFUN %$ETEST
  2033.        (L L1)
  2034.        (PROG(A Q)
  2035.         (SETQ Q (CDRAS 'Q L))
  2036.         (COND ((EQUAL Q 1)(SETQ A 0)(GO LOOP)))
  2037.         (SETQ A (CDRAS 'A L))
  2038.         LOOP
  2039.         (RETURN (SUBSTL (SUB PAR A)
  2040.                 PAR
  2041.                 (EXECF19 L (CADR L1))))))
  2042.  
  2043. (DEFUN REF
  2044.        (FLG INDEX ARG)
  2045.        (COND ((EQ FLG 'ONEJ)(J1TF INDEX ARG))
  2046.          ((EQ FLG 'TWOJ)(J2TF (CAR INDEX)(CADR INDEX) ARG))
  2047.          ((EQ FLG 'HS)(HSTF INDEX ARG))
  2048.          ((EQ FLG 'HL)(LSTF INDEX ARG))
  2049.          ((EQ FLG 'S)(STF (CAR INDEX)(CADR INDEX) ARG))
  2050.          ((EQ FLG 'ONERF)(ERFTF ARG))
  2051.          ((EQ FLG 'ONELOG)(LOGTF ARG))
  2052.          ((EQ FLG 'ONEKELLIPTIC)(KELLIPTICTF ARG))
  2053.          ((EQ FLG 'ONEE)(ETF ARG))
  2054.          ((EQ FLG 'ONEM)(MTF (CAR INDEX)(CADR INDEX) ARG))
  2055.          ((EQ FLG 'HYP-ONEP)(PTF (CAR INDEX)(CADR INDEX) ARG))
  2056.          ((EQ FLG 'ONEQ)(QTF (CAR INDEX)(CADR INDEX) ARG))
  2057.          ((EQ FLG 'GAMMAGREEK)(GAMMAGREEKTF INDEX ARG))
  2058.          ((EQ FLG 'ONEPJAC)
  2059.           (PJACTF (CAR INDEX)(CADR INDEX)(CADDR INDEX) ARG))
  2060.          ((EQ FLG 'ASIN)(ASINTF ARG))
  2061.          ((EQ FLG 'ATAN)(ATANTF ARG))))
  2062.  
  2063. (DEFUN MTF
  2064.        (I1 I2 ARG)
  2065.        (LIST (MUL (POWER ARG (ADD I2 (1//2)))
  2066.           (POWER '$%E (DIV ARG -2)))
  2067.          (LIST 'FPQ
  2068.            (LIST 1 1)
  2069.            (LIST (ADD* (1//2) I2 (MUL -1 I1)))
  2070.            (LIST (ADD* I2 I2 1))
  2071.            ARG)))
  2072.  
  2073. (DEFUN PJACTF
  2074.        (N A B X)
  2075.        (LIST (MUL* (GM (ADD N A 1))
  2076.            (INV (GM (ADD A 1)))
  2077.            (INV (FACTORIAL N)))
  2078.          (LIST 'FPQ
  2079.            (LIST 2 1)
  2080.            (LIST (MUL -1 N)(ADD* N A B 1))
  2081.            (LIST (ADD A 1))
  2082.            (SUB (1//2)(DIV X 2)))))
  2083.  
  2084. (DEFUN ASINTF
  2085.        (ARG)
  2086.        ((LAMBDA(INV2)
  2087.            (LIST ARG
  2088.              (LIST 'FPQ
  2089.                (LIST 2 1)
  2090.                (LIST INV2 INV2)
  2091.                (LIST (DIV 3 2))
  2092.                (MUL ARG ARG))))
  2093.     (1//2)))
  2094.  
  2095. (DEFUN ATANTF
  2096.        (ARG)
  2097.        (LIST ARG
  2098.          (LIST 'FPQ
  2099.            (LIST 2 1)
  2100.            (LIST (INV 2) 1)
  2101.            (LIST (DIV 3 2))
  2102.            (MUL* -1 ARG ARG))))
  2103.  
  2104. (DEFUN PTF
  2105.        (N M Z)
  2106.        (LIST (MUL (INV (GM (SUB 1 M)))
  2107.           (POWER (DIV (ADD Z 1)(SUB Z 1))(DIV M 2)))
  2108.          (LIST 'FPQ
  2109.            (LIST 2 1)
  2110.            (LIST (MUL -1 N)(ADD N 1))
  2111.            (LIST (SUB 1 M))
  2112.            (SUB (1//2)(DIV Z 2)))))
  2113.  
  2114. (DEFUN QTF
  2115.        (N M Z)
  2116.        (LIST (MUL* (POWER '$%E (MUL* M '$%PI '$%I))
  2117.            (POWER '$%PI (1//2))
  2118.            (GM (ADD* M N 1))
  2119.            (POWER 2 (SUB -1 N))
  2120.            (INV (GM (ADD N (DIV 3 2))))
  2121.            (POWER Z (MUL -1 (ADD* M N 1)))
  2122.            (POWER (SUB (MUL Z Z) 1)(DIV M 2)))
  2123.          (LIST 'FPQ
  2124.            (LIST 2 1)
  2125.            (LIST (DIV (ADD* M N 1) 2)
  2126.              (DIV (ADD* M N 2) 2))
  2127.            (LIST (ADD N (DIV 3 2)))
  2128.            (POWER Z -2))))
  2129.  
  2130. (DEFUN GAMMAGREEKTF
  2131.        (A X)
  2132.        (LIST (MUL (INV A)(POWER X A))
  2133.          (LIST 'FPQ
  2134.            (LIST 1 1)
  2135.            (LIST A)
  2136.            (LIST (ADD A 1))
  2137.            (MUL -1 X))))
  2138.  
  2139. (DEFUN KELLIPTICTF
  2140.        (K)
  2141.        ((LAMBDA(INV2)
  2142.            (LIST (MUL INV2 '$%PI)
  2143.              (LIST 'FPQ
  2144.                (LIST  2 1)
  2145.                (LIST INV2 INV2)
  2146.                (LIST 1)
  2147.                (MUL K K))))
  2148.     (1//2)))
  2149.  
  2150. (DEFUN ETF
  2151.        (K)
  2152.        ((LAMBDA(INV2)
  2153.            (LIST (MUL INV2 '$%PI)
  2154.              (LIST 'FPQ
  2155.                (LIST  2 1)
  2156.                (LIST (MUL -1 INV2) INV2)
  2157.                (LIST 1)
  2158.                (MUL K K))))
  2159.     (1//2)))
  2160.  
  2161. (DEFUN ERFTF
  2162.        (ARG)
  2163.        (LIST (MUL* 2 ARG (POWER '$%PI (INV -2)))
  2164.          (LIST 'FPQ
  2165.            (LIST 1 1)
  2166.            (LIST (1//2))
  2167.            (LIST (DIV 3 2))
  2168.            (MUL* -1 ARG ARG))))
  2169.  
  2170. (DEFUN LOGTF
  2171.        (ARG)
  2172.        (LIST 1
  2173.          (LIST 'FPQ (LIST 2 1)(LIST 1 1)(LIST 2)(SUB 1 ARG))))
  2174.  
  2175. (DEFUN J2TF
  2176.        (N M ARG)
  2177.        (LIST (MUL* (INV (GM (ADD N 1)))
  2178.            (INV (GM (ADD M 1)))
  2179.            (INV (POWER 2 (ADD N M)))
  2180.            (POWER ARG (ADD N M)))
  2181.          (LIST 'FPQ
  2182.            (LIST 2 3)
  2183.            (LIST (ADD* (1//2)(DIV N 2)(DIV M 2))
  2184.              (ADD* 1 (DIV N 2)(DIV M 2)))
  2185.            (LIST (ADD 1 N)(ADD 1 M)(ADD* 1 N M))
  2186.            (MUL -1 (POWER ARG 2)))))
  2187.  
  2188. (DEFUN D*X^M*%E^A*X
  2189.        (EXP)
  2190.        (M2 EXP
  2191.        '((MTIMES)
  2192.          ((COEFFTT)(D FREEVARPAR))
  2193.          ((MEXPT) (X VARP) (M FREEVARPAR))
  2194.          ((MEXPT)
  2195.           (Q EXPOR1P)
  2196.           ((MTIMES)((COEFFTT)(A FREEVARPAR)) (X VARP))))
  2197.        NIL)) 
  2198.  
  2199. (DEFUN EXECF19
  2200.        (L1 L2)
  2201.        (PROG(ANS)
  2202.         (SETQ ANS (EXECARGMATCH (CAR (CDDDDR L2))))
  2203.         (COND ((EQ (CAR ANS) 'DIONIMO)
  2204.            (RETURN (DIONARGHYP L1 L2 (CADR ANS)))))
  2205.         (RETURN 'NEXT-FOR-OTHER-ARGS)))
  2206.  
  2207. (DEFUN EXECFY
  2208.        (L ARG INDEX)
  2209.        (PROG(ANS)
  2210.         (SETQ ANS (EXECARGMATCH ARG))
  2211.         (COND ((EQ (CAR ANS) 'DIONIMO)
  2212.            (RETURN (DIONARGHYP-Y L INDEX (CADR ANS)))))
  2213.         (RETURN 'FAIL-IN-EXECFY)))
  2214. ;executive  for recognizing the sort of argument
  2215.  
  2216. (DEFUN EXECARGMATCH
  2217.        (ARG)
  2218.        (PROG(L1)
  2219.         (COND ((SETQ L1 (A*X^M+C ($FACTOR ARG)))
  2220.            (RETURN (LIST 'DIONIMO L1))))
  2221.         (COND ((SETQ L1 (A*X^M+C ($EXPAND ARG)))
  2222.            (RETURN (LIST 'DIONIMO L1))))
  2223.         (RETURN 'OTHER-CASE-ARGS-TO-FOLLOW)))
  2224.  
  2225. (DEFUN DIONARGHYP
  2226.        (L1 L2 ARG)
  2227.        (PROG(A M C)
  2228.         (SETQ A
  2229.           (CDRAS 'A ARG)
  2230.           M
  2231.           (CDRAS 'M ARG)
  2232.           C
  2233.           (CDRAS 'C ARG))
  2234.         (COND ((AND (MAXIMA-INTEGERP M)(ZERP C))
  2235.            (RETURN (F19COND A M L1 L2))))
  2236.         (RETURN 'PROP4-AND-AOTHER-CASES-TO-FOLOW)))
  2237.  
  2238.  
  2239. (DEFUN F+C
  2240.        (EXP)
  2241.        (M2 EXP
  2242.        '((MPLUS)((COEFFPT)(F HASVAR))((COEFFPP)(C FREEVAR)))
  2243.        NIL))
  2244.  
  2245. (DEFUN A*X^M+C
  2246.        (EXP)
  2247.        (M2 EXP
  2248.        '((MPLUS)
  2249.          ((COEFFPT)
  2250.           (A FREEVAR)
  2251.           ((MEXPT) (X VARP) (M FREEVAR0)))
  2252.          ((COEFFPP) (C FREEVAR)))
  2253.        NIL))
  2254.  
  2255. (DEFUN FREEVAR0(M)(COND ((EQUAL M 0) NIL)(T (FREEVAR M))))
  2256.  
  2257. (DEFUN ADDARGLIST
  2258.        (S K)
  2259.        (PROG(K1 L)
  2260.         (SETQ K1 (SUB K 1))
  2261.         LOOP
  2262.         (COND ((ZERP K1)
  2263.            (RETURN (APPEND (LIST (DIV S K)) L))))
  2264.         (SETQ L
  2265.           (APPEND (LIST (DIV (ADD S K1) K)) L)
  2266.           K1
  2267.           (SUB K1 1))
  2268.         (GO LOOP)))
  2269.  
  2270. (DEFUN F19COND
  2271.        (A M L1 L2)
  2272.        (PROG(P Q S D)
  2273.         (SETQ P
  2274.           (CAADR L2)
  2275.           Q
  2276.           (CADADR L2)
  2277.           S
  2278.           (CDRAS 'M L1)
  2279.           D
  2280.           (CDRAS 'D L1)
  2281.           L1
  2282.           (CADDR L2)
  2283.           L2
  2284.           (CADDDR L2))
  2285.         (COND ((AND (NOT (EQ (CHECKSIGNTM (SUB (ADD* P
  2286.                              M
  2287.                              -1)
  2288.                            Q))
  2289.                  '$POSITIVE))
  2290.             (EQ (CHECKSIGNTM (ADD S 1))
  2291.                 '$POSITIVE))
  2292.            (RETURN (MUL D
  2293.                 (F19P220-SIMP (ADD S 1)
  2294.                           L1
  2295.                           L2
  2296.                           A
  2297.                           M)))))
  2298.         (RETURN 'FAILED-ON-F19COND-MULTIPLY-THE-OTHER-CASES-WITH-D)))
  2299.  
  2300. (DEFUN F19P220-SIMP
  2301.        (S L1 L2 CF K)
  2302.        (MUL* (GM S)
  2303.          (INV (POWER PAR S))
  2304.          (HGFSIMP-EXEC (APPEND L1 (ADDARGLIST S K))
  2305.                L2
  2306.                (MUL* CF
  2307.                 (POWER K K)
  2308.                 (POWER (INV PAR) K))))) 
  2309.  
  2310. (DEFUN J1TF
  2311.        (V Z)
  2312.        (LIST (MUL* (INV (POWER 2 V))
  2313.            (POWER Z V)
  2314.            (INV (GM (ADD V 1))))
  2315.          (LIST 'FPQ
  2316.            (LIST 0 1)
  2317.            NIL
  2318.            (LIST (ADD V 1))
  2319.            (MUL (INV -4)(POWER Z 2)))))
  2320.  
  2321. (DEFUN DIONARGHYP-Y (L INDEX ARG) 
  2322.        (PROG (A M C) 
  2323.          (SETQ A (CDRAS 'A ARG) 
  2324.            M (CDRAS 'M ARG) 
  2325.            C (CDRAS 'C ARG))
  2326.          (COND ((AND (ZERP C) (EQUAL M 1.))
  2327.             (RETURN (F2P105V2COND A L INDEX))))
  2328.          (COND ((AND (ZERP C) (EQUAL M (INV 2.)))
  2329.             (RETURN (F50COND A L INDEX))))
  2330.          (RETURN 'FAIL-IN-DIONARGHYP-Y))) 
  2331.  
  2332. (DEFUN F2P105V2COND (A L INDEX) 
  2333.        (PROG (D M) 
  2334.          (SETQ D (CDRAS 'D L) M (CDRAS 'M L))
  2335.          (SETQ M (ADD M 1.))
  2336.          (COND ((EQ (CHECKSIGNTM ($REALPART (SUB M INDEX)))
  2337.             '$POSITIVE)
  2338.             (RETURN (F2P105V2COND-SIMP D M INDEX A))))
  2339.          (RETURN 'FAIL-IN-F2P105V2COND))) 
  2340.  
  2341. (DEFUN F50COND (A L V) 
  2342.        (PROG (D M) 
  2343.          (SETQ D (CDRAS 'D L) 
  2344.            M (CDRAS 'M L) 
  2345.            M (ADD M (INV 2.)) 
  2346.            V (DIV V 2.))
  2347.          (COND
  2348.           ((AND (EQ (CHECKSIGNTM ($REALPART (ADD M V (INV 2.))))
  2349.             '$POSITIVE)
  2350.             (EQ (CHECKSIGNTM ($REALPART (SUB (ADD M (INV 2.))
  2351.                              V)))
  2352.             '$POSITIVE)
  2353.             (NOT (MAXIMA-INTEGERP (MUL (SUB (ADD M M) (ADD V V 1.))
  2354.                     (INV 2.)))))
  2355.            (SETQ A (MUL A A (INV 4.)))
  2356.            (RETURN (F50P188-SIMP D M V A))))
  2357.          (RETURN 'FAIL-IN-F50COND))) 
  2358.  
  2359. (DEFUN F2P105V2COND-SIMP (D M V A) 
  2360.        (MUL -2.
  2361.         (POWER '$%PI -1.)
  2362.         (GM (ADD M V))
  2363.         (POWER (ADD (MUL A A) (MUL PAR PAR)) (MUL -1. (INV 2.) M))
  2364.         (LEG2FSIMP (SUB M 1.)
  2365.                (MUL -1. V)
  2366.                (MUL PAR
  2367.                 (POWER (ADD (MUL A A) (MUL PAR PAR))
  2368.                    (INV -2.)))))) 
  2369.  
  2370. (DEFUN LEG1FSIMP (M V Z) 
  2371.        (MUL (INV (GM (SUB 1. M)))
  2372.         (POWER (DIV (ADD Z 1.) (SUB Z 1.)) (DIV M 2.))
  2373.         (HGFSIMP-EXEC (LIST (MUL -1. V) (ADD V 1.))
  2374.               (LIST (SUB 1. M))
  2375.               (SUB (INV 2.) (DIV Z 2.))))) 
  2376.  
  2377. (DEFUN LEG2FSIMP (M V Z) 
  2378.        (MUL (POWER '$%E (MUL M '$%PI '$%I))
  2379.         (POWER '$%PI (INV 2.))
  2380.         (GM (ADD M V 1.))
  2381.         (INV (POWER 2. (ADD V 1.)))
  2382.         (INV (GM (ADD V (DIV 3. 2.))))
  2383.         (POWER Z (SUB -1. (ADD M V)))
  2384.         (POWER (SUB (MUL Z Z) 1.) (MUL (INV 2.) M))
  2385.         (HGFSIMP-EXEC (LIST (DIV (ADD M V 1.) 2.)
  2386.                 (DIV (ADD M V 2.) 2.))
  2387.               (LIST (ADD V (MUL 3. (INV 2.))))
  2388.               (INV (MUL Z Z))))) 
  2389. (declare-top (unspecial asinx atanx))